如何循环访问文件夹并将所有文件导入Access（VBA）

问题描述：

嘿Geys我坚持使用我的代码，并且无法继续使用它... （maby我只是对它很感兴趣）如何循环访问文件夹并将所有文件导入Access（VBA）

这是我的代码：

Const ForReading = 1, ForWriting = 2, ForAppending = 8 
Dim fso, MyFile, FileName, TextLine 
Dim TextArray() 
Dim x As Double 
Dim SQLString 


Set fso = CreateObject("Scripting.FileSystemObject") 

FileName = "C:\Users\ava\Desktop\TEST_IMPORT\1.txt" 

Set MyFile = fso.OpenTextFile(FileName, ForReading) 


Do While MyFile.AtEndOfStream <> True 
    ReDim Preserve TextArray(x) 
    TextLine = MyFile.ReadLine 
    TextArray(x) = TextLine 
    x = x + 1 

Loop 

MyFile.Close 

SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');" 

DoCmd.SetWarnings (WarningsOff) 

DoCmd.RunSQL SQLString 

DoCmd.SetWarnings (WarningsOn) 

End Sub

该代码，是从我的桌面（1.txt的）文本文件然后将数据导入到我的访问DB

这工作适合我的一个文件。（1.TXT）

我发现This Link如何通过一个文件夹循环...

如何实现这到我的代码？

感谢您的帮助！

它可能是实际上有助于解释代码是干什么的，通过文件夹要循环，你想选择哪种类型的文件，并且这种 –

我将广告在我的问题 – kint

答

即时假设您正在读取文件夹C:\Users\ava\Desktop中扩展名为.txt的每个文件。

尝试......

Dim TextArray() 
Dim x As Double 
Dim SQLString 

Set fso = CreateObject("Scripting.FileSystemObject") 

strFolder= "C:\Users\ava\Desktop" 'sets folder 
strFileName = Dir(strFolder & "\*.txt") 'grabs first txt file 

Do While strFileName <> 0 'starts loop 
    FileName = strFileName 'set filename 

    Set MyFile = fso.OpenTextFile(FileName, ForReading) 

    '' Read from the file 
    Do While MyFile.AtEndOfStream <> True 
      ReDim Preserve TextArray(x) 
      TextLine = MyFile.ReadLine 
      TextArray(x) = TextLine 
      x = x + 1 
    Loop 

    MyFile.Close 

    SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');" 

    DoCmd.SetWarnings (WarningsOff) 

    DoCmd.RunSQL SQLString 

    DoCmd.SetWarnings (WarningsOn) 

    strFileName = Dir 'Grabs next txt file 
Loop

这使我一个错误....顺便说一句，这正是我试图做 – kint

运行时错误5无效的过程或无效的参数 – kint

设置MyFile = fso.OpenTextFile（FileName，ForReading） – kint

答

我不知道为什么你一遍又一遍又一遍用TextArray，但考虑做这样的。

Option Compare Database 

Private Sub Command0_Click() 


     Dim strPathFile As String, strFile As String, strPath As String 
     Dim strTable As String 
     Dim blnHasFieldNames As Boolean 

     ' 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\rschuell\Desktop\test\" 

     ' Replace tablename with the real name of the table into which 
     ' the data are to be imported 
     strTable = "tablename" 

     strFile = Dir(strPath & "*.txt") 
     Do While Len(strFile) > 0 
       strPathFile = strPath & strFile 

       DoCmd.TransferText _ 
       TransferType:=acImportDelim, _ 
       TableName:=strTable, _ 
       FileName:=strPathFile, _ 
       HasFieldNames:=blnHasFieldNames 


     ' Uncomment out the next code step if you want to delete the 
     ' EXCEL file after it's been imported 
     '  Kill strPathFile 

       strFile = Dir() 
     Loop 



End Sub

如何循环访问文件夹并将所有文件导入Access（VBA）

相关推荐