Tüm Excel dosyaları aynı sayfalara sahip olmadığında Access'e birden çok Excel dosyasını ve çalışma sayfasını içe aktarın

Question

Yaklaşık 75 Excel dosyası içeren bir klasörüm var (.xlsx). Excel dosyalarının hepsinin beş adlı çalışma sayfası olması gerekir (örneğin: SurveyData, AmphibianSurveyObservationData, BirdSurveyObservationData, PlantObservationData ve WildSpeciesObservationData). Ne yazık ki, bazen Excel dosyaları çalışma sayfalarının yalnızca bir alt kümesine sahiptir (yani, One Excel dosyasının tüm beş çalışma sayfası olabilir, diğeri ise yalnızca SurveyData ve AmphibianSurveyObservationData çalışma sayfalarına sahip olur).

Tüm bu Excel dosyalarını Access'e aktarmak ve her çalışma sayfasından ayrı bir tabloya bilgi almak istiyorum. Örneğin, tüm Excel dosyalarındaki SurveyData çalışma sayfasındaki tüm verilerin SurveyData adlı bir Erişim Tablosuna yerleştirilmesini istiyorum. Bu VBA kodunu (aşağıya bakın) buldum ve tüm çalışma sayfaları Excel dosyasında bulunduğunda iyi çalışıyor gibi görünüyor, ancak bir çalışma sayfası eksik olduğunda, komut dosyası durur ve diğer dosyalardan herhangi birini içe aktarmaya devam etmez. Excel dosyasında mevcutsa, yalnızca bir çalışma sayfasını içe aktarmanın herhangi bir yolu var mı, yoksa yalnızca içe aktarmayı atlamak mı?

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

Ben şöyle sadece hata işleme ayarlayabilirsiniz düşünüyorum: Herhangi bir satırda bir başarısızlık alırsanız

On Error Resume Next 

Ardından, VBA sadece sonraki satıra atlar.

Bu, sizin durumunuzda çalışacağından% 100 emin değilim, ama bir deneyin. Ayrıca

referans: Test or check if sheet exists

Answer 2

koleksiyonlara göz ardından çalışma sayfaları ve yineler varlığına göre değişik VBA koleksiyonları içine dosyaları tek tek kaydeder bu yaklaşımı göz önünde bulundurun:

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

aşağıda senaryo için iyi çalıştı ben mi. Sadece alan adlarınızın Excel üstbilgileri ile Erişim alanı adları arasında eşleştiğinden emin olun. çalışmak gibiydi

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