我正在尝试在Access 2010中创建一个打开excel文件的宏,在excel中运行宏,然后导入给定的结果。这个过程我有2个问题。
On Error Resume
吗?但我想在最后一个消息框中包含它没有附加的表。这是可能的,你能指出我正确的方向吗?我已经尝试了一些errorhandeling但我不知道如何在不中断流程的情况下弹出消息。代码:
Private Sub Main_btn_Click()
Dim fileImport(0 To 3, 0 To 2) As String
fileImport(0, 0) = "Stock_CC"
fileImport(0, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Stock_getdata.xlsm"
fileImport(0, 2) = "GetStock"
fileImport(1, 0) = "Wips_CC"
fileImport(1, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\Wips_getdata.xlsm"
fileImport(1, 2) = "Update"
fileImport(2, 0) = "CCA_cc"
fileImport(2, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\SLAcc.xls"
fileImport(2, 2) = "Read_CCA"
fileImport(3, 0) = "Eps_cc"
fileImport(3, 1) = "F:\370\Hyperviseur\SITUATIE\Macro\eps.xlsm"
fileImport(3, 2) = "Update"
Dim i As Integer
For i = 0 To UBound(fileImport, 1)
RunMacroInxcel fileImport(i, 1), fileImport(i, 2)
transferSpreadsheetFunction fileImport(i, 0), fileImport(i, 1)
Next i
End Sub
Private Sub RunMacroInExcel(fName As String, macroName As String)
Dim Xl As Object
'Step 1: Start Excel, then open the target workbook.
Set Xl = CreateObject("Excel.Application")
Xl.Workbooks.Open (fName)
Xl.Visible = True
Xl.Run (macroName)
Xl.ActiveWorkbook.Close (True)
Xl.Quit
Set Xl = Nothing
End Sub
Private Sub transferSpreadsheetFunction(ByVal tableName As String, ByVal fileName As String)
If FileExist(fileName) Then
DoCmd.TransferSpreadsheet acImport, , tableName, fileName, True
Else
Dim Msg As String
Msg = "Bestand niet gevonden" & Str(Err.Number) & Err.Source & Err.Description
MsgBox (Msg)
End If
End Sub
Function FileExist(sTestFile As String) As Boolean
Dim lSize As Long
On Error Resume Next
lSize = -1
lSize = FileLen(sTestFile)
If lSize > -1 Then
FileExist = True
Else
FileExist = False
End If
End Function
答案 0 :(得分:0)
在For循环中添加错误处理,连接到字符串变量,然后在消息框中添加字符串:
Dim i As integer, failedFiles as string
failedFiles = "List of failed tables: " & vbNewLine & vbNewLine
For i = 0 To UBound(fileImport, 1)
On Error Goto NextFile
Call RunMacroInxcel(fileImport(i, 1), fileImport(i, 2))
Call transferSpreadsheetFunction(fileImport(i, 0), fileImport(i, 1))
NextFile:
failedFiles = failedFiles & " " & fileImport(i,0) & vbNewLine
Resume NextFile2
NextFile2:
Next i
MsgBox failedFiles, vbInformation, "Failed Tables List"