我正在尝试从MS Access 2010导出文件然后它抛出错误3673,同时成功导出在MS Access 2003文件中运行相同的代码。我只在MS Access 2010中收到此错误。代码如下:
Private Sub PostcalcReport_Click()
Dim FileName As String
Dim strPath As String
Dim db As Database
Set db = CurrentDb()
Dim intChoice As Integer
Dim i As Integer
Dim sSQL As String
Dim rs As DAO.Recordset
Dim strText As String
'make the file dialog visible to the user
strFilePath = BrowseFolder("Please Select Path to Export PPM file to")
On Error GoTo PROC_ERR
If strFilePath <> "" Then
'displays the result in a message box
Call MsgBox(strFilePath, vbInformation, "Save Path")
sSQL = "SELECT * FROM ODM_UNCTLD_TBL_DATE"
Set rs = CurrentDb.OpenRecordset(sSQL)
strText = rs!BILLING_DATE
FileName = strFilePath & "Prepaymnet Meter Post-Calc_" & Format(strText, "mm_yy") & ".xls"
File = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
DoCmd.OpenQuery "QryPostCalcProc", acViewNormal, acEdit
DoCmd.TransferSpreadsheet acExport, 8, "PPM_POST_CALC", FileName, True, "A1:I"
i = DCount("*", "PPM_POST_CALC")
DoCmd.TransferSpreadsheet acExport, 8, "PPM_POST_CALC_TAB2", FileName, True, "A" & (i + 3) & ":I"
'Format the file
strWkbkName = FileName
Set objXL = CreateObject("Excel.Application")
objXL.Workbooks.Open (strWkbkName)
With objXL
'Format first row as bold
.Rows("1:1").Font.Bold = True
.Rows("" & (i + 3) & ":" & (i + 3) & "").Font.Bold = True
'Resizes the columns
.Columns("A:Z").Autofit
' .Save
.ActiveWorkBook.Save
End With
objXL.Workbooks.Close
Set objXL = Nothing
'Format the file ends
db.Execute "INSERT INTO odm_unctld_tbl_audit ([FilePath],[FileName],[action],[trans_date],[button])" _
& " values ( '" & FileName & "', '" & File & "' , ""'Export_of_PostCalc_report'"" ,Now() ,""'Export PPM Post calculation Report'"");"
MsgBox "PPM Post Calc Report Exported successfully", vbInformation, "Message"
Else
MsgBox "Please Provide a file path before exporting!", vbCritical + vbOKOnly
End If
On Error GoTo Skip
Skip:
If Err.Number > 0 Then
PROC_ERR:
' Run whatever codes if error occurs
MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
Err.Clear
End If
On Error GoTo 0
End Sub