I'm having a problem open an excel spreedsheet that I transfered data to from access. It use to work in access 2003, the we changed over to office 2007 and the code quit working. On the line "Application.Fo llowHyperlink" I get an error "Cannot open specified file" In the subroutine I call it does open the file and transfers data to it, but I can't get it to open once the data is there. Any advice on how to fix this.
Code:
Private Sub cmdgraph_Click()
Dim designtype As String
On Error GoTo err_Handler
designtype = InputBox("Please Enter The Design Type", "Design Type")
MsgBox ExportRequest(designtype), vbInformation, "Finished"
Application.FollowHyperlink ("N:\Pd0013\Operations\Bar data\Bar Elactrical Data.xlsx")
lblmsg.Caption = "Status"
exit_Here:
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Error"
Resume exit_Here
End Sub
Public Function ExportRequest(designtype) As String
On Error GoTo err_Handler
' Excel object variables
Dim appExcel As Object
Dim ExcelWorkbook As Object
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim parameter As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.parameter
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Const cTabTwo As Byte = 1
Const cStartRow As Byte = 8
Const cStartColumn As Byte = 4
DoCmd.Hourglass True
'forcing the parameter of the query to the value inputed into the form
parameter = designtype
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
sTemplate = "N:\Pd0013\Operations\Bar data\bedt.xlsx"
sOutput = "N:\Pd0013\Operations\Bar data\Bar Electrical Data.xlsx"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database object
'Set appExcel = Excel.Application
Set appExcel = CreateObject("Excel.Application")
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabTwo)
' looking for the parameters of the query
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs!selectbuildquery
For Each prm In qdf.Parameters
prm.Value = parameter
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF Then rst.MoveFirst
' For this template, the data must be placed on the 8th row, 2nd column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblmsg.Caption = "Exporting record #" & lRecords & " to Bar Electrical Data.xlsx"
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)
If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If
wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next
wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop
ExportRequest = "Total of " & lRecords & " rows processed."
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
err_Handler:
ExportRequest = Err.Description
Me.lblmsg.Caption = Err.Description
Resume exit_Here
End Function
Comment