访问VBA:丢弃“无法附加”消息(主键违规)

时间:2015-05-29 14:42:16

标签: vba excel-vba ms-access-2010 excel

我正在尝试在Access 2010中创建一个打开excel文件的宏,在excel中运行宏,然后导入给定的结果。这个过程我有2个问题。

  1. Excel中的Application.DisplayAlerts = False      然而DisplayAlerts不断涌现。我是否需要在宏Access中做一些特别的事情?
  2. 警告“因主键违规无法追加”不断弹出。我知道问题是什么,但我想忽略它。我可以使用On Error Resume吗?但我想在最后一个消息框中包含它没有附加的表。这是可能的,你能指出我正确的方向吗?我已经尝试了一些errorhandeling但我不知道如何在不中断流程的情况下弹出消息。
  3. 代码:

    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
    

1 个答案:

答案 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"