I'm trying to use the code below to import multiple csvs into one table. For some reason it imports all csvs but creates a separate table for each instead of importing into the UKR table.
I'm using Access 2016 and UKR is a blank table with no field names or data.
Can anyone see what the issue is?
Thanks
Option Compare Database
Option Explicit
Function DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strPath = "C:\UKR\"
strTable = "UKR"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = Left(strFile, Len(strFile) - 4)
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
MsgBox "done"
End Function
Because code is resetting the destination table within the loop. Remove line
strTable = Left(strFile, Len(strFile) - 4)
Related
I am trying to import exported objects from another database. The file extension is vba. I have created a loop to go through all the objects. My loop does go through all the files properly. The loop does import a module as Module 1 for the first file. I want to rename the module from module 1 to the previous module name.
I am working with MS Access office 365.
Sub LoopThroughFiles2()
Dim strFile As String
Dim strNewFile As String
Dim strPath As String
Dim strNewPath As String
Dim strDBName As String
Dim strModName As String
strDBName = Application.CurrentProject.Name
strPath = ("C:\Users\Parents\Google Drive\Access Files\File7\")
strFile = Dir(strPath & "*")
Do While Len(strFile) > 0
Debug.Print strFile
Debug.Print strPath
strNewFile = Replace(strFile, ".vba", ".txt", 1, , vbTextCompare)
Debug.Print strNewFile
Name strPath & strFile As strPath & strNewFile
strNewPath = strPath & strFile
strModName = Replace(strNewFile, ".txt", "")
Debug.Print strModName
VBE.ActiveVBProject.VBComponents.Import strNewPath
VBProj.VBComponents("Module 1").Name = strModName 'error 424
DoCmd.Rename strModName, acModule, "Module1" 'error 7874
Loop
End Sub
You can't change the name directly, but you can change a property instead, like this:
VBE.ActiveVBProject.VBComponents("Module 1").Properties("Name").Value = strModName
I am trying to match excel files which is placed in a folder with tables which exist in access database (with the same name as my excel files) and trying to import data which is in excel to access.
Sub import()
Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String
blnHasFieldNames = True
strPath = "D:\PersonalData\working_table\"
strWorksheet = "Sheet1"
' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xlsx")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
strTable = Left(strFile, InStrRev(strFile, ".xlsx") - 1)
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel9, strTable, strPathFile, _
blnHasFieldNames, strWorksheet & "$"
DoCmd.RunSQL ("DELETE * FROM " & strTable & " WHERE SPEC_ID = 'Specification ID'")
strFile = Dir()
Loop
End Sub
I am successfully able to get the data into my access database tables, however my requirement is to delete the row from all such tables where SPEC_ID = 'Specification ID' . I am getting an error in line:
DoCmd.RunSQL ("DELETE * FROM " & strTable & " WHERE SPEC_ID = 'Specification ID'")
which states:
Run-time error: '3131'
Syntax error in FROM clause.
Kindly guide me what I may have been doing wrong.
Thanks in advance.
Using DoCmd.SetWarnings is a recipe for trouble. What if there is an error in the sql and your code exits without setting the warnings back to true? All sorts of weird stuff happens. Instead use the simpler and just as easy
CurrentDb.Execute "DELETE * FROM [" & strTable & "] WHERE SPEC_ID = 'Specification ID'"
You'll still need to check that strTable doesn't have [ or ] in the name (otherwise the bracketing won't be effective) and you'll need to either remove them or escape them (depending on how your actual table is named).
do like this
Docmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM [" & strTable & "] WHERE SPEC_ID = 'Specification ID'")
Docmd.SetWarnings True
I have multiple very similar CSV files saved in the same directory which I want to import into Access in one go. I want them to all go to one table.
I did some research, taught myself some VBA basics and ended up with this script:
Public Function Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strPath = "C:\Downloads\models"
strTable = "ModelData"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
End Function
Trying to run the macro doesn't do anything and I'm stuck where to move forward from here.
I followed the same guide to running a macro in this quick minute long video: https://www.youtube.com/watch?v=mXdn7ca2BX4
I'm hoping I just missed a little step somewhere...
Also, I think I need to import each column in text format as one is not returning date/time data correctly.
I have tried to follow some similar questions on here however I do not really understand VBA coding :/
Any help would be great! thanks!
For CSV file files you have to use DoCmd.TransferText:
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:=strTable, _
FileName:=strPathFile, _
HasFieldNames:=True
I am currently importing a folder full of excel files into Access using the code below. I want to export macro to others, but with the hard coded path it would not work for others. But I am not sure how to change the path to accept a user input I would like to try and make something like a file explorer but not sure how.
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' accept excel first line as headers for tables
blnHasFieldNames = True
' Path to files
strpath = "C:\Users\MyName\Desktop\Test\"
strFile = Dir(strpath & "*.xls")
'import all files within selected folder
Do While Len(strFile) > 0
strPathFile = strpath & strFile
strTable = Left(strFile, Len(strFile) - 5)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
Below is what I have tried changing though I am given an error of "Method 'filedialog' of object_'Application' failed" and am not sure if I am using this incorrectly.
strpath = Application.FileDialog(msoFileDialogFilePicker)
Thanks to HansUp for the help on solving this.
The to select a folder and upload all files within the folder is below...
Const msoFileDialogFolderPicker As Long = 4
Dim objfiledialog As Object
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' accept excel first line as headers for tables
blnHasFieldNames = True
'select folder and set path
Set objfiledialog = Application.FileDialog(msoFileDialogFolderPicker)
With objfiledialog
.AllowMultiSelect = False
If .Show Then
strpath = .SelectedItems(1) & Chr(92)
End If
End With
strFile = Dir(strpath & "*.xls")
'import all files within selected folder
Do While Len(strFile) > 0
strPathFile = strpath & strFile
strTable = Left(strFile, Len(strFile) - 5)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
Private Sub Command38_Click()
Dim f As Object
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strUpdate As String
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant
Dim P As String
Dim DeleteEverything As String
DoCmd.SetWarnings False
DeleteEverything = "DELETE * FROM [ucppltr]"
DoCmd.RunSQL DeleteEverything
Set f = Application.FileDialog(3)
f.AllowMultiSelect = True
f.InitialFileName = "S:\Formware\outfile\ucppt12\Storage"
f.Filters.Clear
f.Filters.Add " Armored TXT Files", "*.asc"
If f.Show Then
For Each varItem In f.SelectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
P = strFolder & strFile
DoCmd.TransferText acImportDelim, "UCPP Import Specification", "ucppltr", P, False
Next
End If
strUpdate = "PARAMETERS fileName Text;" & vbCrLf & _
"UPDATE ucppltr" & vbCrLf & _
"Set [File Name] = fileName"
Debug.Print strUpdate
Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strUpdate)
qdf.Parameters("fileName") = strFile
qdf.Execute dbFailOnError
Set qdf = Nothing
Set db = Nothing
Set f = Nothing
MsgBox DCount("*", "ucppltr") & " Records were imported"
End Sub
As you can see from the code on import I want to store the file name and while it does work it doesn't work exactly how I need it to. When we do work for this client it is 5 files ate a time once a week so I would like it to save all 5 file names however it only saves the last one it imports. My question, is there a way to save each file name to each one ( I doubt that) or can I save all 5 file names to all the records I import instead of just the last file name?
I always have the option of only allowing a single import and making them import and append the table 5 times I just wanted to check to see if there is a more efficent way before doing so.
Thanks in advance for any help in this matter!
There is a problem in your logic. Inside the loop, strFile holds the current file name. So after your loop is finished, only the current (=last) file name is passed on to the query.
I made some changes, so the filenames are now stored in the new variable strFileList, delimited by a ";". Please check, if this is a feasible solution.
Private Sub Command38_Click()
Dim f As Object
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strUpdate As String
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant
Dim P As String
Dim DeleteEverything As String
' Variable to hold file list
Dim strFileList As String
DoCmd.SetWarnings False
DeleteEverything = "DELETE * FROM [ucppltr]"
DoCmd.RunSQL DeleteEverything
Set f = Application.FileDialog(3)
f.AllowMultiSelect = True
f.InitialFileName = "S:\Formware\outfile\ucppt12\Storage"
f.Filters.Clear
f.Filters.Add " Armored TXT Files", "*.asc"
If f.Show Then
For Each varItem In f.SelectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
P = strFolder & strFile
DoCmd.TransferText acImportDelim, "UCPP Import Specification", "ucppltr", P, False
'Add file name to file list
strFileList = strFileList & strFile & ";"
Next
End If
strUpdate = "PARAMETERS fileName Text;" & vbCrLf & _
"UPDATE ucppltr" & vbCrLf & _
"Set [File Name] = fileName"
Debug.Print strUpdate
Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strUpdate)
'Pass file list to query
qdf.Parameters("fileName") = strFileList
qdf.Execute dbFailOnError
Set qdf = Nothing
Set db = Nothing
Set f = Nothing
MsgBox DCount("*", "ucppltr") & " Records were imported"
End Sub