複数のExcelファイルとワークシートをすべてのExcelファイルに同じシートがない場合にAccessにインポートする

Question

私は約75のExcelファイル（.xlsx）を持つフォルダを持っています。 Excelファイルには、すべて名前付きワークシートが5つあります（たとえば、SurveyData,AmphibianSurveyObservationData、BirdSurveyObservationData、PlantObservationData、およびWildSpeciesObservationData）。残念ながら、Excelファイルにはワークシートのサブセットのみが存在することがあります（Excelファイル1つに5つのワークシートがあり、別のExcelファイルにはSurveyDataとAmphibianSurveyObservationDataのワークシートしかない）。

これらのExcelファイルをすべてAccessにインポートし、各ワークシートの情報を別のテーブルに入れたいと思います。たとえば、すべてのExcelファイルのSurveyDataワークシートのすべてのデータをSurveyDataというアクセステーブルに入れたいとします。私はこのVBAコードを見つけました（下記参照）、ワークシートがすべてExcelファイルに存在するとうまくいくように見えますが、1つのワークシートがないと、スクリプトは停止し、他のファイルのインポートを続行しません。ワークシートがExcelファイルに存在する場合にのみインポートする方法はありますか？それ以外の場合はインポートをスキップしますか？

Function ImportExcelFiles() 
Dim strFile As String 

    DoCmd.SetWarnings False 

    ' Set file directory for files to be imported 
    strPath = "D:\SpeciesData\MoELoadform\2015SpeciesDetectionLoadforms - Copy\" 
    ' Tell it to import all Excel files from the file directory 
    strFile = Dir(strPath & "*.xls*") 

    ' Start loop 
    Do While strFile <> "" 
     ' Import file 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="SurveyData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="SurveyData!A1:AD" 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="AmphibianSurveyObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="AmphibianSurveyObservationData!A1:AQ" 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="BirdSurveyObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="BirdSurveyObservationData!A1:AQ" 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="PlantObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="PlantObservationData!A1:BS" 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="WildSpeciesObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="WildSpeciesObservationData!A1:AP" 
    ' Loop to next file in directory 
     strFile = Dir 
    Loop 

    MsgBox "All data has been imported.", vbOKOnly 
    End Function 

Answer 1

私は次のようにあなただけのエラー処理を設定することができると思う：あなたがいずれかのライン上の失敗を取得する場合

On Error Resume Next 

その後、VBAだけで次の行にジャンプします。

これはあなたのケースではうまくいくはずですが、試してみてください。また

参照：Test or check if sheet exists

Answer 2

コレクションを通じて、その後のワークシートや繰り返し処理の有無に応じて様々なVBAのコレクションに個々のファイルを保存し、この方法を検討してください：

Public Function ImportExcelFiles() 

Dim strpath As String, strFile As String 
Dim xlApp As Object, xlWkb As Object, xlWks As Object 

Dim allColl As New Collection 
Dim surveyColl As New Collection, amphibColl As New Collection 
Dim birdColl As New Collection, plantColl As New Collection 
Dim speciesColl As New Collection 

Dim item As Variant, coll As Variant 

DoCmd.SetWarnings False 

' Set file directory for files to be imported 
strpath = "D:\SpeciesData\MoELoadform\2015SpeciesDetectionLoadforms - Copy\" 
' Tell it to import all Excel files from the file directory 
strFile = Dir(strpath & "*.xls*") 

Set xlApp = CreateObject("Excel.Application") 

' LOOP THROUGH FILES 
Do While strFile <> "" 

    Set xlWkb = xlApp.Workbooks.Open(strpath & strFile) 

    ' LOOP THROUGH WORKSHEETS 
    For Each xlWks In xlWkb.Worksheets   
     Select Case xlWks.Name    
      Case "SurveyData" 
      surveyColl.Add Array(strpath & strFile, "SurveyData") 
      Case "AmphibianSurveyObservationData" 
      amphibColl.Add Array(strpath & strFile, "AmphibianSurveyObservationData") 
      Case "BirdSurveyObservationData" 
      birdColl.Add Array(strpath & strFile, "BirdSurveyObservationData") 
      Case "PlantObservationData" 
      plantColl.Add Array(strpath & strFile, "PlantObservationData") 
      Case "WildSpeciesObservationData" 
      speciesColl.Add Array(strpath & strFile, "WildSpeciesObservationData")  
     End Select    
    Next xlWks 

    strFile = Dir 
    xlWkb.Close False 

Loop 

' LOOP THROUGH EACH COLLECTION AND IMPORT 
allColl.Add surveyColl: allColl.Add amphibColl 
allColl.Add birdColl: allColl.Add plantColl 
allColl.Add speciesColl 

For Each coll In allColl 
    For Each item In coll 
     ' ASSUMES WORKSHEETS AND TABLE NAMES ARE SAME 
     DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:=item(1), _ 
       FileName:=item(0), HasFieldNames:=True, Range:=item(1) & "!" 
    Next item 
Next coll 

Set xlWks = Nothing 
Set xlWkb = Nothing 
Set xlApp = Nothing 

DoCmd.SetWarnings True 
MsgBox "All data has been imported.", vbOKOnly 

End Function 

Answer 3

以下のスクリプトがためにうまく働きました私。 Excelヘッダーとアクセスフィールド名のフィールド名が一致していることを確認してください。

Option Compare Database 

Private Sub Command0_Click() 

Dim strPathFile As String, strFile As String, strPath As String 
Dim blnHasFieldNames As Boolean 
Dim intWorksheets As Integer 

' Replace 3 with the number of worksheets to be imported 
' from each EXCEL file 
Dim strWorksheets(1 To 5) As String 

' Replace 3 with the number of worksheets to be imported 
' from each EXCEL file (this code assumes that each worksheet 
' with the same name is being imported into a separate table 
' for that specific worksheet name) 
Dim strTables(1 To 5) As String 

' Replace generic worksheet names with the real worksheet names; 
' add/delete code lines so that there is one code line for 
' each worksheet that is to be imported from each workbook file 
strWorksheets(1) = "SurveyData" 
strWorksheets(2) = "AmphibianSurveyObservationData" 
strWorksheets(3) = "BirdSurveyObservationData" 
strWorksheets(4) = "PlantObservationData" 
strWorksheets(5) = "WildSpeciesObservationData" 

' Replace generic table names with the real table names; 
' add/delete code lines so that there is one code line for 
' each worksheet that is to be imported from each workbook file 
strTables(1) = "SurveyData" 
strTables(2) = "AmphibianSurveyObservationData" 
strTables(3) = "BirdSurveyObservationData" 
strTables(4) = "PlantObservationData" 
strTables(5) = "WildSpeciesObservationData" 

' Change this next line to True if the first row in EXCEL worksheet 
' has field names 
blnHasFieldNames = True 

' Replace C:\Documents\ with the real path to the folder that 
' contains the EXCEL files 
strPath = "C:\Users\xxx\Desktop\All_Excel_Files\" 

' Replace 3 with the number of worksheets to be imported 
' from each EXCEL file 
For intWorksheets = 1 To 5 
On Error Resume Next 
     strFile = Dir(strPath & "*.xlsx") 
     Do While Len(strFile) > 0 
      strPathFile = strPath & strFile 
      DoCmd.TransferSpreadsheet acImport, _ 
        acSpreadsheetTypeExcel9, strTables(intWorksheets), _ 
        strPathFile, blnHasFieldNames, _ 
        strWorksheets(intWorksheets) & "$" 
      strFile = Dir() 
     Loop 

Next intWorksheets 

End Sub