Importing multiple files in to one table

[GODZILLA]

Hello,

I have been atempting to minipulate this bit of code to allow me to import around 300 files at onc in to a table. All the files have the same structure.

Does anyone have the solution im looking for?

Private Sub cmdImport_Click()
On Error GoTo ErrHandler
   
   Dim oFSystem As Object
   Dim oFolder As Object
   Dim oFile As Object
   Dim sFolderPath As String
   Dim SQL As String
   Dim i As Integer
    
   sFolderPath = [B]"C:\My Documents\"[/B]
   
   Set oFSystem = CreateObject("Scripting.FileSystemObject")
   Set oFolder = oFSystem.GetFolder(sFolderPath)
  
   For Each oFile In oFolder.files
     If Right(oFile.Name, 4) = ".dbf" Then
       SQL = "Insert into [tblFORMGUIDE]" _
           & " Select """ & Left(oFile.Name, 7) & """ as [Key],*" _
           & " from " & Left(oFile.Name, Len(oFile.Name) - 4) _
           & " IN """ & sFolderPath & """ ""dBASE 5.0;"""
       
       DoCmd.SetWarnings False
       DoCmd.RunSQL SQL
       DoCmd.SetWarnings True
       i = i + 1
     End If
   Next
   
   MsgBox i & " dbf files were imported."
   Exit Sub
   
ErrHandler:
   MsgBox Err.Description
End Sub

 

[Trevor G]

Take a look at my code here, I do this for excel spreadsheets. You would need to adapt it slightly, as the transferspreadsheet will have to be text, I have commeted out the kill part as this would delete the files it finds.

Get all excel spreadsheets into a table then delete them

Option Compare Database

Const strpath = "C:\ATest\Access\"
Function GetFIleNames()
Dim FolderLength As Integer
Dim fName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File

Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(strpath)

For Each objFile In objFolder.Files
FolderLength = Len(strpath) + 1
fName = Mid(objFile, FolderLength)
Dim strfile


strfile = Dir("*.xls")
Do While Len(strfile) > 0
DoCmd.TransferSpreadsheet acImport, 8, "tblstaffImport", strpath & strfile, True
'Kill strpath & strfile
strfile = Dir
Loop


Next objFile
MsgBox "All Spreadsheets have been transferred"

End Function

 

[GODZILLA]

Take a look at my code here, I do this for excel spreadsheets. You would need to adapt it slightly, as the transferspreadsheet will have to be text, I have commeted out the kill part as this would delete the files it finds.

Get all excel spreadsheets into a table then delete them

Option Compare Database

Const strpath = "C:\ATest\Access\"
Function GetFIleNames()
Dim FolderLength As Integer
Dim fName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File

Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(strpath)

For Each objFile In objFolder.Files
FolderLength = Len(strpath) + 1
fName = Mid(objFile, FolderLength)
Dim strfile


strfile = Dir("*.xls")
Do While Len(strfile) > 0
DoCmd.TransferSpreadsheet acImport, 8, "tblstaffImport", strpath & strfile, True
'Kill strpath & strfile
strfile = Dir
Loop


Next objFile
MsgBox "All Spreadsheets have been transferred"

End Function

Will this work in relation to .CSV files too?

 

[Trevor G]

I should think so, but if you look in access within the macro section and create a transfertext macro it will give you all the parts you need, you can then place the macro on a form and convert the macro to vba and that will give you the docmd command line you will need.

 

[GODZILLA]

Dim objFSO As FileSystemObject

It does not like this varible. Im using 97 is that the problem?

 

[Trevor G]

Have a look at this link as it suggests you should set the reference to Microsoft Scripting Runtime reference library

http://www.utteraccess.com/forum/Write-Text-File-FileSy-t765372.html

 

[GODZILLA]

Have a look at this link as it suggests you should set the reference to Microsoft Scripting Runtime reference library

http://www.utteraccess.com/forum/Write-Text-File-FileSy-t765372.html

Thanks! looks like the basics are working it just needs some tweeking now.

 

[Trevor G]

Pleased its working for you, good luck with the tweeks.

 

[GODZILLA]

Im trying to use this to import differntly based on the file name.

However when it imports the next type it takes the information from the previous file.

It is almost like i need to refresh the varible.

This is the code.

Const strpath = "C:\"
Function GetFIleNames()
 
Dim FolderLength As Integer
Dim fName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim i As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strpath)
For Each objFile In objFolder.Files
FolderLength = Len(strpath) + 1
fName = Mid(objFile, FolderLength)
Dim strfile
strfile = Dir("*.CSV")
'############### CLOSURE FILES ##################
If Mid(objFile.Name, 4, 7) = "CLOSURE" Then
DoCmd.TransferText acImportDelim, "AC_data_IS", "tbl_AC_data", strpath & "\" & strfile, False, ""
DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qry_update_closure_import_date")
DoCmd.SetWarnings (True)
i = i + 1
End If
 
'################## LOAD FILES ##################
If Mid(objFile.Name, 4, 4) = "LOAD" Then
DoCmd.TransferText acImportDelim, "ALData IS", "tbl_AL_data", strpath & "\" & strfile, False, ""
DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qry_update_load_import_date")
DoCmd.SetWarnings (True)
i = i + 1
End If
 
Next objFile
MsgBox i & " file/s have been transferred"
End Function

 

[Trevor G]

Why not consider moving the file once imported, so you have some kind of archive or check area. This is only a suggestion, I can look at the whole code sometime during this week.

Sub MoveFiles()
Dim oldFilePath as String
Dim newFilePath as String

Oldfilepath = “Enter the path to the files\” 7”*.txt”
Newfilepath = “Enter the new path” & Format(Date, “dd mmm yyy”) & “.txt”
Name oldfilepath as newfilepath
End Sub

 

[Trevor G]

Ive just looked to use some code it will do the import of all csv files in a folder, I think you will have to check it out but it does work.

Function Import_multi_csv()

Dim fs, fldr, fls, fl
Set fs = CreateObject("Scripting.FileSystemObject")
Set fldr = fs.getfolder("C:\Name Files\")
Set fls = fldr.files
For Each fl In fls

If Right(fl.Name, 4) = ".csv" Then
'DoCmd.TransferText acImportDelim, , "tblName", "fldr" & fl.Name, True
DoCmd.TransferText acImportDelim, , "tblName", fldr & "\" & fl.Name, True
End If

Next fl
End Function