2015-05-29 20 views
0

我試圖在Access 2010中創建一個宏,打開一個Excel文件,在Excel中運行宏,然後導入給定的結果。我在這個過程中遇到了兩個問題。訪問VBA:放棄「無法追加」消息(主鍵違例)

  1. Application.DisplayAlerts =在Excel 假然而DisplayAlerts保持雨後春筍般冒出來。我需要在宏Access中做一些特殊的事情嗎?
  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 
+2

無碼這是相當困難來幫助你。 .. –

+0

這是給你錯誤的代碼,還是錯誤來自在4個工作簿中執行的宏?你調用'RunMacroInxcel',但是有'Private Sub RunMacroInExcel'。我認爲這只是一個複製/粘貼錯誤。對於你的錯誤**#1 ** - 你在哪裏設置Application.DisplayAlerts = False?我在這段代碼中沒有看到它。 – FreeMan

回答

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"