Solved Mass Importing Txt Files (1 Viewer)

N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
I am looking for a better way to import txt files rather than me having to select the file and then import all the files are within 1 folder

Dim strFileName
Dim oExcel As Excel.Application
Dim oWb As Excel.Workbook
Set oExcel = CreateObject("Excel.Application")
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
Dim strFolderName As String
Dim strFolderExists As String


With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Add "Text Files", "*.TXT", 1
.Filters.Add "All Files", "*.*", 2
.InitialFileName = "C:\importing\cash\"
If .Show = -1 Then
strFileName = .SelectedItems(1)

Dim content As String
Dim var As Variant
Dim path As String

'put the path and filename of textfile here
path = .SelectedItems(1)

With CreateObject("Scripting.FileSystemObject")
With .OpenTextFile(path, 1)
content = .ReadAll
.Close
End With
var = Split(content, vbCrLf)
For I = 1 To UBound(var)
var(I - 1) = var(I)
Next
ReDim Preserve var(UBound(var) - 1)
content = Join(var, vbCrLf)
With .OpenTextFile(path, 2)
.Write content
.Close
End With
End With

DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", strFileName, vbNo

Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
Loop

Kill strFileName

End If
End With
Click to expand...
 
E

ebs17

Well-known member
Local time
Today, 07:53
Joined
Feb 7, 2020
Messages
1,946
I find it convincing if you put the files to be imported in a fixed, known folder. You can then go through this folder in a simple loop and import the files one after the other.
Code: 
Sub DoIt()
    Dim sPath As String
    Dim sFile As String

    sPath = "C:\Testing\"             
    sFile = Dir(sPath & "TEST*.csv")                     
    Do While sFile > vbNullString         
        'Debug.Print sFile, sPath & sFile                         

        ' import / somehow use the file
    
        ' if necessary, delete the file (VBA.Kill) or move the file to an archive (VBA.Name)

        sFile = Dir                                 
    Loop
End Sub
The loop with Dir offers a pattern search so that selection can be made quite well.

Ideally, if I have a text file, I would link this file as a table and use an append query to transfer the information to the database table. Depending on the database schema, it might also be necessary to distribute the data across several tables with several queries.
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:53
Joined
May 7, 2009
Messages
19,243
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    Dim oWb As Excel.Workbook
    Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer
    strFolderName = "C:\importing\cash\"
   
    strFileName = Dir$(strFolderName & "*.txt")
   
    Do Until Len(strFileName) = 0
        j = j + 1
        col.Add Item:=strFolderName & strFileName, Key:=j & ""
        strFileName = Dir$
    Loop
   
    For j = 1 To col.Count

            With CreateObject("Scripting.FileSystemObject")
                With .OpenTextFile(col(j & ""), 1)
                    content = .ReadAll
                    .Close
                End With
                var = Split(content, vbCrLf)
                For I = 1 To UBound(var)
                    var(I - 1) = var(I)
                Next
                ReDim Preserve var(UBound(var) - 1)
                content = Join(var, vbCrLf)
                With .OpenTextFile(col(j & ""), 2)
                    .Write content
                    .Close
                End With
            End With

            DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

            Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
            Loop

            Kill col(j & "")

    Next j
 
N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
arnelgp said:
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    Dim oWb As Excel.Workbook
    Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer
    strFolderName = "C:\importing\cash\"
  
    strFileName = Dir$(strFolderName & "*.txt")
  
    Do Until Len(strFileName) = 0
        j = j + 1
        col.Add Item:=strFolderName & strFileName, Key:=j & ""
        strFileName = Dir$
    Loop
  
    For j = 1 To col.Count

            With CreateObject("Scripting.FileSystemObject")
                With .OpenTextFile(col(j & ""), 1)
                    content = .ReadAll
                    .Close
                End With
                var = Split(content, vbCrLf)
                For I = 1 To UBound(var)
                    var(I - 1) = var(I)
                Next
                ReDim Preserve var(UBound(var) - 1)
                content = Join(var, vbCrLf)
                With .OpenTextFile(col(j & ""), 2)
                    .Write content
                    .Close
                End With
            End With

            DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

            Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
            Loop

            Kill col(j & "")

    Next j
Click to expand...
Ok thank you for sharing, i am getting a run time error using this code..
1706695652112.png
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:53
Joined
May 7, 2009
Messages
19,243
maybe declare var As Variant?
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    Dim oWb As Excel.Workbook
    Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer, i As Integer
    Dim var As Variant
    
    strFolderName = "C:\importing\cash\"
    
    strFileName = Dir$(strFolderName & "*.txt")
    
    Do Until Len(strFileName) = 0
        j = j + 1
        col.Add Item:=strFolderName & strFileName, Key:=j & ""
        strFileName = Dir$
    Loop
    
    For j = 1 To col.Count

            With CreateObject("Scripting.FileSystemObject")
                With .OpenTextFile(col(j & ""), 1)
                    content = .ReadAll
                    .Close
                End With
                var = Split(content, vbCrLf)
                For i = 1 To UBound(var)
                    var(i - 1) = var(i)
                Next
                ReDim Preserve var(UBound(var) - 1)
                content = Join(var, vbCrLf)
                With .OpenTextFile(path, 2)
                    .Write content
                    .Close
                End With
            End With

            DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

            Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
            Loop

            Kill col(j & "")

    Next j
 
E

ebs17

Well-known member
Local time
Today, 07:53
Joined
Feb 7, 2020
Messages
1,946
DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", strFileName, vbNo True

Use the HasFieldNames argument and save yourself all the rearranging of content in the text files. The whole FSO block is unnecessary.

This is simpler and leaves no room for additional errors
 
N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
arnelgp said:
maybe declare var As Variant?
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    Dim oWb As Excel.Workbook
    Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer, i As Integer
    Dim var As Variant
   
    strFolderName = "C:\importing\cash\"
   
    strFileName = Dir$(strFolderName & "*.txt")
   
    Do Until Len(strFileName) = 0
        j = j + 1
        col.Add Item:=strFolderName & strFileName, Key:=j & ""
        strFileName = Dir$
    Loop
   
    For j = 1 To col.Count

            With CreateObject("Scripting.FileSystemObject")
                With .OpenTextFile(col(j & ""), 1)
                    content = .ReadAll
                    .Close
                End With
                var = Split(content, vbCrLf)
                For i = 1 To UBound(var)
                    var(i - 1) = var(i)
                Next
                ReDim Preserve var(UBound(var) - 1)
                content = Join(var, vbCrLf)
                With .OpenTextFile(path, 2)
                    .Write content
                    .Close
                End With
            End With

            DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

            Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
            Loop

            Kill col(j & "")

    Next j
Click to expand...
Thanks added that getting another error now on

1706698437685.png


1706698456241.png
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:53
Joined
May 7, 2009
Messages
19,243
replace path with col(j & "")
 
N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
arnelgp said:
replace path with col(j & "")
Click to expand...
Thank you yes that worked, so now for a different question, i also have to import other text files they are in a folder and has then a folder for each day, folders are named as the date like this 2024-01-31 and contain 2-3 files in each folder how's best to get these to import in bulk too ?
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:53
Joined
May 7, 2009
Messages
19,243
put the foldername to a table, then you can use a Recordset to loop through the each folder:

tblFolders
Path (short text)

example:
Path
-------------------------------------------
C:\importing\cash\
C:\importing\2024-01-31\

using same code:
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    'Dim oWb As Excel.Workbook
    'Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer, i As Integer
    Dim var As Variant
    Dim db As DAO.Database
    
    Set db = CurrentDb
    
    With db.OpenRecordset("tblFolders", dbOpenSnapshot, dbReadOnly)
        Do Until .EOF
        
            strFolderName = !path
    
            strFileName = Dir$(strFolderName & "*.txt")
    
            Do Until Len(strFileName) = 0
                j = j + 1
                col.Add Item:=strFolderName & strFileName, Key:=j & ""
                strFileName = Dir$
            Loop
    
            For j = 1 To col.Count

                With CreateObject("Scripting.FileSystemObject")
                    With .OpenTextFile(col(j & ""), 1)
                        content = .ReadAll
                        .Close
                    End With
                    var = Split(content, vbCrLf)
                    For i = 1 To UBound(var)
                        var(i - 1) = var(i)
                    Next
                    ReDim Preserve var(UBound(var) - 1)
                    content = Join(var, vbCrLf)
                    With .OpenTextFile(path, 2)
                        .Write content
                        .Close
                    End With
                End With

                DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

                Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                    DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
                Loop

                Kill col(j & "")

            Next j
            .MoveNext
        Loop
        .Close
    End With
    Set db = Nothing
 
N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
arnelgp said:
put the foldername to a table, then you can use a Recordset to loop through the each folder:

tblFolders
Path (short text)

example:
Path
-------------------------------------------
C:\importing\cash\
C:\importing\2024-01-31\

using same code:
Code: 
    Dim strFileName
    Dim oExcel As Excel.Application
    'Dim oWb As Excel.Workbook
    'Set oExcel = CreateObject("Excel.Application")
    Dim strFolderName As String
    Dim strFolderExists As String

    Dim col As New Collection
    Dim j As Integer, i As Integer
    Dim var As Variant
    Dim db As DAO.Database
  
    Set db = CurrentDb
  
    With db.OpenRecordset("tblFolders", dbOpenSnapshot, dbReadOnly)
        Do Until .EOF
      
            strFolderName = !path
  
            strFileName = Dir$(strFolderName & "*.txt")
  
            Do Until Len(strFileName) = 0
                j = j + 1
                col.Add Item:=strFolderName & strFileName, Key:=j & ""
                strFileName = Dir$
            Loop
  
            For j = 1 To col.Count

                With CreateObject("Scripting.FileSystemObject")
                    With .OpenTextFile(col(j & ""), 1)
                        content = .ReadAll
                        .Close
                    End With
                    var = Split(content, vbCrLf)
                    For i = 1 To UBound(var)
                        var(i - 1) = var(i)
                    Next
                    ReDim Preserve var(UBound(var) - 1)
                    content = Join(var, vbCrLf)
                    With .OpenTextFile(path, 2)
                        .Write content
                        .Close
                    End With
                End With

                DoCmd.TransferText acImportFixed, "Cash Import Specification", "Cash_Importing", col(j & ""), vbNo

                Do Until IsNull(DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'"))
                    DoCmd.DeleteObject acTable, DLookup("Name", "Msysobjects", "Name like '*ImportErrors*'")
                Loop

                Kill col(j & "")

            Next j
            .MoveNext
        Loop
        .Close
    End With
    Set db = Nothing
Click to expand...
setup the table as you have suggested and started the job it imported all the files within the first folder and deleted them as planned and it threw up this error...

1706710908077.png


1706710935379.png


if i now try to start the job again its says..
1706711431336.png

1706710935379.png
 
Last edited:
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:53
Joined
May 7, 2009
Messages
19,243
sorry, you need to reset the Collection object again.
add this, line like this:

Code: 
...
...
      .MoveNext
      Set col = New Collection
      j = 0
  Loop
  .Close
End With
set db = Nothing
 
N

Number11

Member
Local time
Today, 06:53
Joined
Jan 29, 2020
Messages
607
arnelgp said:
sorry, you need to reset the Collection object again.
add this, line like this:

Code: 
...
...
      .MoveNext
      Set col = New Collection
      j = 0
  Loop
  .Close
End With
set db = Nothing
Click to expand...
thanks also had to change

With .OpenTextFile(path, 2)
to

With .OpenTextFile(col(j & ""), 2)

running now...
 
E

ebs17

Well-known member
Local time
Today, 07:53
Joined
Feb 7, 2020
Messages
1,946
Number11 said:
I am looking for a better way to import txt files rather than me having
Click to expand...
Just shyly asked back:
A massive code shortening and simplification plus acceleration of the overall process see #6 probably doesn't play a role in this search?
 
You must log in or register to reply here.

Similar threads

N
Code does not support certain characters such as full-width symbols or Chinese
Replies
1
Views
341
ebs17
E
F
Add query data to existing export function
Replies
1
Views
354
MarkK
MarkK
F
Solved Add result from one function to another export function
Replies
18
Views
704
FoolzRailer
F
P
Solved Access vba Manage an Attachment field with vba
Replies
8
Views
441
Pat Hartman
P
Kayleigh
Avast blocking auto-update macro
Replies
4
Views
179
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom