Loading duplicate files with ImportError in Ms access - vba

I have a VBA code which is loading the files from the folder but it ends up loading each file two times but the duplicated one has Import errors.
Here is my VBA code
Option Compare Database
Option Explicit
Public Function import_data_files()
Dim report_path As String
Dim filename As String
report_path = "C:\Users\greencolor\Company & Co\Desktop\Autoreport\So_load\"
filename = Dir(report_path & "*.csv", vbDirectory)
Do While filename <> vbNullString
DoCmd.TransferText acImportDelim, , Trim(Replace(filename, ".csv", "")), report_path & filename, True
filename = Dir
Loop
MsgBox "Data files imported! Report is updated!", vbInformation
End Function

Related

Excel file does not load in MS access

It runs without any Error message but the files are not loaded in MS access. what could be the reason? I do have a csv file in the directory
After edit
Option Compare Database
Option Explicit
Public Function import_date_files()
Dim report_path As String, file_name As String
report_path = "C:\Users\gobro7\MS access test\weekly_load\"
file_name = Dir(report_path & "*.xlsx")
Do While file_name <> vbNullString
DoCmd.TransferText acImportDelim, , Trim(Replace(file_name, ".xlsx", "")), report_path & file_name, True
file_name = Dir
Loop
MsgBox "Data loaded", vbInformation
End Function
You need to add a backslash between the path and the file name. You can either write
file_name = Dir(report_path & "\*.csv")
Do While file_name <> vbNullString
DoCmd.TransferText acImportDelim, , Trim(Replace(file_name, ".csv", "")), report_path & "\" & file_name, True
file_name = Dir
Loop
Or you add the backslash at the end of your path definition:
' Note the trailing backslash!
report_path = "C:\Users\gobro7\OneDrive - Levi Strauss & Co\MS access test\weekly_load\"
file_name = Dir(report_path & "*.csv")
Do While file_name <> vbNullString
DoCmd.TransferText acImportDelim, , Trim(Replace(file_name, ".csv", "")), report_path & file_name, True
file_name = Dir
Loop

TransferSpreadsheet acImport defaulting to documents folder - Run-time error 3011 (Access VBA)

Using DoCmd.TransferSpreadsheet acImport isn't working for me currently. I am trying to import .xlsx files and I am using the wildcard (*) to complete the file name. When I use a MsgBox, FullPath is correct, but when the TransferSpreadsheet runs, it says it can't find the file in C:\Users\Me\Documents (the default location).
Dim FPath As String
Dim FName As String
Dim FullPath As String
FPath = CurrentProject.Path & "\Data\"
FName = "DataTable"
FullPath = Dir(FPath & FName & "*.xlsx")
If FullPath <> "" Then
DoCmd.TransferSpreadsheet acImport, 10, TableName, FullPath, 1
Else: MsgBox "Error - file not found"
End If
Why is it not looking in the place where I designate? Is this error incorrect and it is indicating something else?
Dir() only returns a file name or nothing (empty string). It does not return a full path.
Dim FPath As String
Dim FileName As String
FPath = CurrentProject.Path & "\Data\"
FileName = Dir(FPath & "DataTable*.xlsx")
If FileName <> "" Then
DoCmd.TransferSpreadsheet acImport, 10, TableName, FPath & FileName, 1
Else
MsgBox "Error - file not found"
End If

Add field filepath for multiple Excel file import within Access

I have the following Module in Access:
On Error Resume Next
Dim strDir As String
Dim strFile As String
Dim I As Long
I = 0
strDir = "C:\excelTest\"
strFile = Dir(strDir & "*.xlsx")
While strFile <> ""
I = I + 1
strFile = strDir & strFile
Debug.Print "importing " & strFile
DoCmd.TransferSpreadsheet acImport, , "mainTable", strFile, False 'has columnheaders
strFile = Dir()
Wend
MsgBox "Load Finished"
importExcelSheets = I
End Function
This imports the data from the xlsx files within the directory (C:\excelTest). This all works fine, but how can I add an additional field which stores the directory and file?
ie. If I have a file test.xlsx during the import a field is created and the path C:\excelTest\test.xlsx is stored.
After records are imported, run an SQL UPDATE action with criteria that distinguishes those new records from previously existing, possibly a date value. Something like:
CurrentDb.Execute "UPDATE tablename SET fieldname = '" & strFile & "' WHERE datefield = #" & <some date input here> & "#"

Create an Excel file for each Access file (.mdb) in folder with tables as sheets

The task
An external program is continually producing small .mdb database files. The data from the database tables must be loaded into STATA for data processing.
The workflow I've created so far is this:
Step 1: Use a VBA macro (in Access) to extract the tables into sheets in an Excel workbook
Step 2: Use another VBA macro (in Excel) to clean the variables for STATA import
Step 3: Use the plugin xls2dta (in STATA) to merge the sheets into a single .dta file
I can do this for a single file at a time, but I would like to do this in a folder of up to 100 .mbd-files in a single run.
(This question is about step 1 in particular, but I've added the rest as context. If you have a better or more direct route to accomplish the main task, please let me know in a comment).
Working code for step 1 for a single file:
The following is the VBA macro I'm using to create the .xls for a single file (a modified version of the code from this answer: https://stackoverflow.com/a/13248627/1685346):
Sub exportTables2XLS()
Dim table As DAO.TableDef, database As DAO.Database
Dim filePath As String, file As String, outFile As String
filePath = CurrentProject.Path
file = CurrentProject.Name
Set database = CurrentDb()
'Export all tables to outFile
outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
For Each table In database.TableDefs
If Left(table.Name, 4) = "MSys" Then
'Do nothing -- Skip system tables
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
table.Name, outFile, True, Replace(table.Name, "dbo_", "")
End If
Next
End Sub
Almost working code for step 1 as a batch operation
Looping through the folder with Dir gives the following:
Sub batchExportTables2XLS()
Dim table As DAO.tabledef, database As DAO.database
Dim file As String, filePath As String, outFile As String
Dim wrkAcc As Object
filePath = CurrentProject.Path
file = Dir(filePath & "/*.mdb")
Do Until file = ""
Set wrkAcc = CreateWorkspace("", "admin", "", dbUseJet)
Set database = wrkAcc.OpenDatabase(file)
'Export all tables to outFile
outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
For Each table In database.TableDefs
If Left(table.Name, 4) = "MSys" Then
'Do nothing -- Skip system tables
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
table.Name, outFile, True, Replace(table.Name, "dbo_", "")
End If
Next
file = Dir()
Loop
End Sub
This macro produce a .xls file for each .mdb in the folder, but they all contain sheets corresponding to the tables in the .mdb from where the macro is run. I feel that this is very close, but how can I get the code to produce the correct output?
This issues is because DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, table.Name, outFile, True, Replace(table.Name, "dbo_", "") takes places in the current Application instance(aka where the macro is running, in this case the Access Application you've opened). To change that we need to give it the correct Application to trigger this command.
I've made some adjustments to your code to give you an idea of what to do. Not sure if you require the Workspace functionality or if that was just what you found on the web, this instead opens a new instance of Access, loads the databases one at a time, and exports the sheets within THAT instance of the Access Application.
Sub batchExportTables2XLS()
Dim table As DAO.TableDef, database As DAO.database
Dim file As String, filePath As String, outFile As String
Dim appAccess As New Access.Application
filePath = CurrentProject.Path
file = Dir(filePath & "\*.mdb")
Do Until file = ""
appAccess.OpenCurrentDatabase filePath & "\" & file
'Export all tables to outFile
outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
For Each table In appAccess.CurrentDb.TableDefs
If Left(table.Name, 4) = "MSys" Then
'Do nothing -- Skip system tables
Else
appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, table.Name, outFile, True, Replace(table.Name, "dbo_", "")
End If
Next
appAccess.CloseCurrentDatabase
file = Dir()
Loop
Set appAccess = Nothing
End Sub

VBA code to grab all files in folder is not finding files

I am trying to set up a macro to pull all excel files in a folder into a database in access. I have the below code, but when I run the macro, it errors out into "No Files Found," so intFile = 0. However, there are files in the chosen folder. Why is it not finding them? I think I messed up the linking piece too but one problem at a time. I am obviously pretty new to VBA, so any help would be appreciated!
Thanks,
Option Compare Database
Option Explicit
'code will link to excel and pull site survey files into access tables
'Setting the path for the directory
Const strPath As String = "S:\LOG\PURCHASI\Daniel Binkoski\Outlook Attachments\R7398Z Look Forward Daily Snapshot"
'FileName
Dim strFile As String
'Array
Dim strFileList() As String
'File Number
Dim intFile As Integer
Sub Sample()
strFile = Dir(strPath & "*.xlsx")
'Looping through the folder and building the file list
strFile = Dir(strPath & "*.xlsx")
While strFile <> ""
'adding files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'checking to see if files where found
If intFile = 0 Then
MsgBox "No Files Found"
Exit Sub
End If
'going through the files and linking them to access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferSpreadsheet acLink, , _
strFileList(intFile), strPath & strFileList(intFile), True, "A1:M50"
Next
MsgBox UBound(strFileList) & "Files were linked"
End Sub
try:
strFile = Dir(strPath & "\*.xlsx", vbNormal)
or add a final "\" onto your strPath value
You need another path separator to show you're looking in a directory, not at one.
I often use something like:
Dir(strPath & IIf(Right(strPath, 1) = "\", vbNullString, "\"))
as a check to ensure that the path always ends in a trailing backslash.