I'm pretty new to using VBA. I have an access database where the user clicks a button and this will upload multiple files.
The files uploaded are temp tables and get fields added to them etc. Once updates have been made to the temp tables, the records get transferred into a permanent table.
It uploads multiple files at once, so as files get uploaded the table they get input into tables called'temp_filename', with each file getting its own table.
Below is my code. For the alter table statement I want to upload the temp table which has just been created. As this table will be named something different every time I tried to assign it to a variable. I tried different syntax etc, however I keep getting errors. Can anyone see where I am going wrong? Any help would be appriciated.
Public Sub Import()
Dim oFileDiag As Office.FileDialog
Dim path As String: path = ""
Dim oFSO As New FileSystemObject
Dim FileSelected As Variant
Dim FileNameSelected As Variant
Dim UpdatedTableName As Variant
Set oFileDiag = Application.FileDialog(msoFileDialogFilePicker) ''Picks file to import
oFileDiag.AllowMultiSelect = True ''Allows multiple files to be selected
oFileDiag.Title = "Please select the reports to upload"
oFileDiag.Filters.Clear
oFileDiag.Filters.Add "Excel Spreadsheets", "*.xlsx, *.xls" ''Only allows xlsx and xls file types to upload
If oFileDiag.Show Then
For Each FileSelected In oFileDiag.SelectedItems
FileNameSelected = oFSO.GetFileName(FileSelected)
UpdatedTableName = "temp_" & FileNameSelected
If oFileDiag.SelectedItems.Count > 0 Then path = oFileDiag.SelectedItems(1)
If Len(path) > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, UpdatedTableName, path, 1
DoCmd.RunSQL "ALTER TABLE UpdatedTableName ADD COLUMN [Date_of_Report] TEXT(100);"
MsgBox "The " & FileNameSelected & " file has been uploaded"
Else
MsgBox "File not found"
End If
Next
End If
You need to concatenate the table name into the SQL string:
DoCmd.RunSQL "ALTER TABLE [" & UpdatedTableName & "] ADD COLUMN [Date_of_Report] TEXT(100);"
I've used square brackets just in case there are things like spaces in the table name.
Regards,
Related
I have the path of the files stored in MS Access in a table.
The table was made to rename a specific set of files, so the important fields are oldpath and newpath. These are used in VBA. First I bring the the data setting a recordset. Afterwards I do a while not to process all the oldpath using RenameFileOrDir function.
The function renames all file names that are not in Chinese.
Public Function TestNameStatement()
Dim fOK As Boolean
Set rs_images = CurrentDb.OpenRecordset("Select import_acc.* from import_acc")
rs_images.MoveLast
rs_images.MoveFirst
Do While Not rs_images.EOF
oldlocation = rs_images.Fields("oldpath")
newlocation = rs_images.Fields("newpath")
' Folders must exist for Source, but do not need to exist for destination
fOK = RenameFileOrDir("" & oldlocationx & "", "" & newlocationx & "")
rs_images.MoveNext
Loop
On Error Resume Next
End Function
Go to Access options, Language,add chinese language
I am looking to use VBA to update links for an external input file. I am a developer and the path for the linked input file I use will not be the same as the end user will need once it is placed in a production folder.
Is there a way to update the linked file location using VBA? I already have code that allows the user to specify the input file location and that information is saved in the [InputFolder] of the [Defaults] table. Is there a way to use VBA to update the Linked Table using the InputFolder field info?
The stored InputFolder data looks like this:
C:\Users\CXB028\OneDrive - Comerica\Projects\HR\Input Data
The new folder info would have a network drive location path defined that I do not have access to but the user would.
Here is the code I use to define and store the Input Folder location:
Private Sub btnInputFldr_Click()
On Error GoTo Err_Proc
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 fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Choose Folder"
.Show
.InitialFileName = "" 'DFirst("InputFolder", "Defaults")
If .SelectedItems.Count = 0 Then
Exit Sub
Else
CurrentDb.Execute "UPDATE Defaults SET InputFolder='" & .SelectedItems(1) & "';"
End If
End With
Me.txtInputFldr.Requery
Exit Sub
Err_Proc:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Process Error"
End Sub
The linked table (an external excel spreadsheet) needs to be re-linked after the database is moved to the production location using VBA code when the new Input Folder is redefined.
I found some very simple and short code the worked great!! Please see below.
On Error Resume Next
'Set new file path location if the TABLE.FIELDNAME location exists
Set tbl = db.TableDefs("ENTER THE LINKED TABLE NAME HERE")
filePath = DLookup("ENTER YOUR LOOKUP TABLE FIELD NAME HERE", "ENTER YOUR LOOKUP TABLE NAME HERE") & "\ENTER YOUR EXCEL SPREADSHEET NAME HERE.XLSX"
tbl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" & filePath
tbl.RefreshLink
On Error GoTo 0
Hope someone else finds this as useful as I did!
so I have 10k csv files i need to look through.
Pretty I have a loop which goes through the list of reports. It imports the csv from a particular file and then does query exports the result back out moves on to the next csv however, because there are 10k csv files the database grows past its maximum 2GB is there a way to refresh the database mid loop to? Something like "Application.SetOption 'Auto compact', True" which works.
Set rs = CurrentDb.OpenRecordset("Select * From NormalReports") 'Table of reports
If Not (rs.EOF And rs.BOF) Then 'This loop goes through each normal directory and creates the winners list for directory.
rs.MoveFirst
Do Until rs.EOF = True
Directory = rs!Directory
ReportName = rs!Name
NUMBDATASTr = Directory & "NUMBDATM.CSV"
NICHDATMSTr = Directory & "NICHDATM.CSV"
PRNTDATMSTr = Directory & "PRNTDATM.CSV"
If Directory Like "E:*" Then
CTRY = "UK"
ElseIf Directory Like "F:*" Then
CTRY = "FR"
ElseIf Directory Like "G:*" Then
CTRY = "PW"
ElseIf Directory Like "H:*" Then
CTRY = "ES"
ElseIf Directory Like "I:*" Then
CTRY = "IT"
ElseIf Directory Like "J:*" Then
CTRY = "AT"
ElseIf Directory Like "K:*" Then
CTRY = "DE"
ElseIf Directory Like "R:*" Then
CTRY = "RU"
ElseIf Directory Like "N:*" Then
CTRY = "NO"
ElseIf Directory Like "C:*" Then
CTRY = "UK"
Else
MsgBox "Invalid directory Found"
Exit Sub
End If
DoCmd.SetWarnings False
DoCmd.OpenQuery "ResetNumbDatM"
DoCmd.OpenQuery "ResetNICHDATM"
DoCmd.OpenQuery "ResetPRNTDATM"
DoCmd.SetWarnings True
'Current Issues data types of the tables conflicting make sure to change that. Issue Noted: 06/07/2018. Resolved: NOT
Dim CombLoop As Integer
Dim LotusCn As Object
Dim rsLotus As Object
Dim strSql, CombFileName, GotoRange As String
Dim rsLotusFiles As DAO.Recordset
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
DoCmd.SetWarnings False
DoCmd.TransferText TransferType:=acImportDelim, TableName:="NUMBDATM", FileName:=NUMBDATASTr, HasFieldNames:=True
DoCmd.DeleteObject acTable, "NUMBDATM_ImportErrors"
DoCmd.TransferText TransferType:=acImportDelim, TableName:="PRNTDATM", FileName:=PRNTDATMSTr, HasFieldNames:=True
DoCmd.DeleteObject acTable, "PRNTDATM_ImportErrors"
DoCmd.TransferText TransferType:=acImportDelim, TableName:="NICHDATM", FileName:=NICHDATMSTr, HasFieldNames:=True
DoCmd.DeleteObject acTable, "NICHDATM_ImportErrors"
DoCmd.SetWarnings True
'Save Path for First Export
SaveFile = Directory & "AWD_" & MTH & ".csv"
'End of Save Path First Export
'Display Winners and create the table
DoCmd.SetWarnings False
DoCmd.OpenQuery "AWDWINNERSQRY"
DoCmd.SetWarnings True
'End Display
'Export Winners to their Directory to their individual Directories
db.TableDefs.Refresh
DoCmd.TransferText acExportDelim, , "AWDWinners", SaveFile, True
db.TableDefs.Refresh
'Export to Directory Finished
SaveFile = "Q:\CCNMACS\AWD" & CTRY & "\AWD_" & MTH & ReportName & ".csv"
'Export Winners to their Directory to their individual Directories
db.TableDefs.Refresh
DoCmd.Rename "AWDWinners" & ReportName, acTable, "AWDWinners"
DoCmd.TransferText acExportDelim, , "AWDWinners" & ReportName, SaveFile, True
db.TableDefs.Refresh
'Export to Directory Finished
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "AWDWinners" & ReportName
DoCmd.SetWarnings True
Application.SetOption "Auto compact", True
rs.MoveNext
Loop
Else
MsgBox "There are no Records in the RecordSet."
End If
rs.Close
Set rs = Nothing
You can't easily compact and repair the database you are in mid process, however you can easily do that to another database.
Consider using a separate "Side" database that holds the imported data. You link to that and perform all the importing into that. You can then record the position you have reached in your looped code in the main database , and as often as required you can compact and repair the side database.
As noted one can consider creating an external accDB file, and use that for the processing. That way you can after processing “x” number of files either create a new blank db, or even compact that external accDB.
You also should consider turning off row locking, as this can be a major source of bloat. I seen some process expand a 6 meg file to 126 megs, and turning off row locking resulted in the 6 meg file after processing still at about 6 megs.
So row locking can effect “massive” the amount of bloat (and you get a good deal better performance also!!).
So you can try turning off row locking, but really, just creating a blank external accDB file (and linking to it) would also solve this issue.
Example how to use a temporary mdb/accdb in your application here:
http://www.granite.ab.ca/access/temptables.htm
How about linking the files instead of importing them? Try TransferType:=acLinkDelim...
How about linking to all 10k files, instead of importing them? This will consume a lot less memory. The VBA script below will loop through all files in a folder and link to each one.
'''' LINK TO ALL CSV FILES OR ALL TEXT FILES IN A FOLDER...
Private Sub Command0_Click()
'Macro Loops through the specified directory (strPath)
'and links ALL Excel files as linked tables in the Access
'Database.
Const strPath As String = "C:\your_path_here\" 'Directory Path
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list
strFile = Dir(strPath & "*.csv")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files & link to Access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acLinkDelim, , _
strFileList(intFile), strPath & strFileList(intFile), True, ""
'Check out the TransferSpreadsheet options in the Access
'Visual Basic Help file for a full description & list of
'optional settings
Next
MsgBox UBound(strFileList) & " Files were Linked"
End Sub
As an aside, and this will probably get down-voted just because I like to propose alternate solutions, consider using R or Python to to the manipulate the files. It seems like the process of importing 10k text files is bloating Access up to 2GB. This completely makes sense. Consider doing something like merging all files into one file, and then import that one file into Access. I have no idea how large each file is, but certainly it will be easier to import one file rather than 10k files.
# R:
setwd("C:/Users/Excel/Desktop/TEST")
txt_files <- list.files()
list_of_reads <- lapply(txt_files, readLines)
df_of_reads <- data.frame(file_name = txt_files, contents = do.call(rbind, list_of_reads))
write.csv(df_of_reads, "one_big_CSV.csv", row.names = F)
Or...
# Python
import glob2
filenames = glob2.glob('C:/Users/Excel/Desktop/test/*.txt') # list of all .txt files in the directory
with open('C:/Users/Excel/Desktop/test/outfile.txt', 'w') as f:
for file in filenames:
with open(file) as infile:
f.write(infile.read()+'\n')
Or, finally, use SQL Server, and Bulk Insert all files using a loop. If you want more info on how to do this, post back and let me know.
I have a split database where both the front end and back end are accdb files. Because one of my tables uses the AppendOnly = Yes property, I cannot use the link table manager or the refreshlink property when I move the backend. The backend moves from time to time because my IT loves to reshuffle servers.
So my solution is to write a function which prompts for the backend location, deletes all the currently linked tables, and then loops through all the backend tables and links them to the frontend. On this last part I receive a run time error 3170 could not find suitable ISAM. I don't know why.
Code is below:
Public Function MoveDB()
'this function will replace the linked table manager. It will open a file select dialog box to allow the user to pick the new location of the DB backend.
'It will then break all the current links and then recreate them. We need to do this vice use the relink function because the cases table uses AutoAppend which stores old path data
' and breaks the relink function which is why linked table manager does not work.
' FileDialog Requires a reference to Microsoft Office 11.0 Object Library.
'variables to get the database path
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim DriveLetter As String
Dim NetworkPath As String
Dim DrivePath As String
Dim SubPath As String
'variables to link the database
Dim db As DAO.Database
Dim BEdb As DAO.Database
Dim oldtdf As DAO.TableDef
Dim tblName As String
Dim newtdf As DAO.TableDef
Dim BEtdf As DAO.TableDef
Set db = CurrentDb()
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Do not Allow user to make multiple selections in dialog box
.AllowMultiSelect = False
'set the default folder that is opened
.InitialFileName = CurrentProject.Path & "\BE"
' Set the title of the dialog box.
.Title = "Please select the Database Backend"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Access Databases", "*.accdb"
' Show the dialog box. If the .Show method returns True, the
' user picked a file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'We need to determine the full network path (including server name) to the DB backend. The reason is that different users may have the share drive mapped with different letters.
'If the backend is mapped using the drive letter of the user moving the DB then other users may not have a valid path. The full network path is universal
'Get the mapped drive letter from the path of the selected DB file
DriveLetter = Left$(Trim(fDialog.SelectedItems(1)), 2)
'Get the path of the selected DB file minus the drive letter
SubPath = Mid$(Trim(fDialog.SelectedItems(1)), 3)
'Get the full network path of the mapped drive letter
DrivePath = GETNETWORKPATH(DriveLetter)
'Combine the drive path and the sub path to get the full path to the selected DB file
NetworkPath = DrivePath & SubPath
'MsgBox (NetworkPath)
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
'Now we need to delete all the linked tables
For Each oldtdf In db.TableDefs
With oldtdf
If oldtdf.Attributes And dbAttachedODBC Or oldtdf.Attributes And dbAttachedTable Then
'this is a linked table
tblName = .Name
DoCmd.DeleteObject acTable, tblName
End If
End With
Next oldtdf
tblName = ""
'Now we link all the tables from the backend to the front end
Set BEdb = OpenDatabase(NetworkPath)
For Each BEtdf In BEdb.TableDefs
tblName = BEtdf.Name
If Left(tblName, 4) <> "~TMP" Then
Set newtdf = db.CreateTableDef(strTable)
newtdf.Connect = "Database = " & NetworkPath
newtdf.SourceTableName = tblName
newtdf.Name = tblName
db.TableDefs.Append newtdf
End If
Next BEtdf
End Function
The error occurs on the
db.TableDefs.Append newtdf
line. I'm looking to either make this code work, or a way around the known bug that prevents refreshing links when using the AppendOnly=Yes property.
Thanks in advance for any help.
I think you are just missing the semicolon on your string and remove extra spaces
newtdf.Connect = ";Database=" & NetworkPath
Alternatively, you can use DoCmd.TransferDatabase method and be sure to leave out the MSys tables as they have no direct application use between split files:
If Left(tblName, 4) <> "~TMP" And Left(tblName, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", NetworkPath, _
acTable, tblName, tblName, False
End If
found this and worked for me
DAODataSet.SQL.Text := 'SELECT * FROM Country IN "" ";DATABASE=C:\SIMPLE.MDB;PWD=MyPassword"';
DAODataSet.Open;
I have a linked table, tblREDEIMPORT that is set to a specific path that's only accessible programatically through a FSO import process where it overwrites the previous day's version.
However, while the .xls linked file is always named the same thing, the name of the sheet that it's on changes every day giving me an error like 215380_REDEFILEIMPORTREPORT_230$ is not a valid name, because that was yesterdays sheet name, todays sheetname has a completely different set of numbers before and after.
Through the linked table manager, I'm unable to point the linked table to anything but that sheet. How can I change the linked table path to either always look at the first (and only) spreadsheet in the workbook, or at least change it to dynamically update the name to the worksheet it should be pointing at?
As an alternative to DoCmd.TransferSpreadsheet acLink, ... you can simply "clone" the existing TableDef object, tweak the .SourceTableName property, and swap the updated TableDef object for the existing one. This approach would have the advantage of preserving the existing file location, Excel document type, etc., saving you from the temptation of hard-coding those values into the DoCmd.TransferSpreadsheet statement.
For example, I have a linked table in Access named [LinkedTableInExcel] that points to a sheet named OldSheetName in an Excel document. I can verify that the linked table is working by using a DCount() expression in the VBA Immediate Window
?DCount("*","LinkedTableInExcel")
2
Now if I open the document in Excel and change the sheet name to NewSheetName the linked table in Access stops working
However, I can update the linked table as follows
Sub UpdateExcelLinkedTable()
Dim cdb As DAO.Database
Dim tbd As DAO.TableDef, tbdNew As DAO.TableDef
Dim n As Long
Const LinkedTableName = "LinkedTableInExcel"
Set cdb = CurrentDb
Set tbd = cdb.TableDefs(LinkedTableName)
Debug.Print "Current .SourceTableName is: " & tbd.SourceTableName
On Error Resume Next
n = DCount("*", LinkedTableName)
Debug.Print "The linked table is " & IIf(Err.Number = 0, "", "NOT ") & "working."
On Error GoTo 0
Set tbdNew = New DAO.TableDef
tbdNew.Name = tbd.Name
tbdNew.Connect = tbd.Connect
tbdNew.SourceTableName = "NewSheetName$"
Set tbd = Nothing
cdb.TableDefs.Delete LinkedTableName
cdb.TableDefs.Append tbdNew
Set tbdNew = Nothing
Set tbd = cdb.TableDefs(LinkedTableName)
Debug.Print "Updated .SourceTableName is: " & tbd.SourceTableName
On Error Resume Next
n = DCount("*", LinkedTableName)
Debug.Print "The linked table is " & IIf(Err.Number = 0, "", "NOT ") & "working."
On Error GoTo 0
Set tbd = Nothing
Set cdb = Nothing
End Sub
results:
Current .SourceTableName is: OldSheetName$
The linked table is NOT working.
Updated .SourceTableName is: NewSheetName$
The linked table is working.