I have written code that imports excel files into a access table. As each file is imported the file name is recorded and saved to a separate table named 'FilesDownloaded'.
I would like to add vba code that prior to importing the file it will check to see if the name of the file (myfile) is already saved on the 'FilesDownloaded' table. This will prevent the same file from being imported twice.
Code:
Function Impo_allExcel()
Dim myfile
Dim mypath
Dim que As Byte
Dim rs As DAO.Recordset
que = MsgBox("This proces will import all excel items with the .xls in the folder C:\MasterCard. Please make sure that only the files you want imported are located in this folder. Do you wish to proceed?", vbYesNo + vbQuestion)
If que = 7 Then
Exit Function
Else
'do nothing and proceed with code
End If
DoCmd.SetWarnings (False)
DoCmd.RunSQL "DELETE * FROM tblMaster_Import;"
MsgBox "Please WAIT while we process this request"
mypath = "C:\Master\"
ChDir (mypath)
myfile = Dir(mypath & "*.xls")
Do While myfile <> ""
If myfile Like "*.xls" Then
'this will import ALL the excel files
'(one at a time, but automatically) in this folder.
' Make sure that's what you want.
'DoCmd.TransferSpreadsheet acImport, 8, "tblMasterCard_Import", mypath & myfile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "tblMaster_Import", mypath & myfile, 1
Set rs = CurrentDb.OpenRecordset("FilesDownloaded")
rs.AddNew
rs.Fields("Filename").Value = myfile
rs.Update
rs.Close
Set rs = Nothing
End If
myfile = Dir()
Loop
'append data to tblAll (risk of duplicates at this point)
DoCmd.RunSQL "INSERT INTO tblAll SELECT tblMaster_Import.* FROM tblMaster_Import;"
DoCmd.OpenQuery "qryUpdateDateField", acViewNormal
''this code will apend to an existing table and runs the risk of doubling data.
DoCmd.SetWarnings (True)
MsgBox "Your upload is complete"
End Function
A possible solution is to make a query, which gives you the result of lines in the table FilesDownloaded, with condition that the name is equal to your file. Something like this:
countString = "SELECT COUNT(*) FROM [FilesDownloaded] WHERE [NAMEOFCOL] = " & myFile
Then run the query, and if the result is more than 1, you obviously have it.
Related
Thank you for taking the time to read this.
I am trying to use the LIKE operator to open workbooks. Previously I went with this code which works really well
Report_Name = "\XYZ.xls"
Workbooks.open Filename:= ThisWorkbook.Path & Report_Name
My main goal is to essentially open a report and sometimes the names differ i.e healthdoc or healthassess
I tried utilizing the LIKE operator to pick up on the name of the workbook however I cannot find a way to code it.
Any direction or help is appreciated. Thank you!
I was trying to use this syntax
Dim Report_Name as Workbook
if Report_Name LIKE "*Health*" then
xyz
else
xyz
However I could only get LIKE operator working only with strings
Use FSO to loop through files and check their names:
Option Explicit
Sub Example()
Dim WB As Workbook
Dim FSO As New FileSystemObject
Dim oFolder As Object
Dim oFile As Object
Set FSO = CreateObject("Scripting.filesystemobject")
Set oFolder = FSO.GetFolder("C:\Users\cameron\Documents")
For Each oFile In oFolder.Files
If oFile.Name Like "*Your Partial File Name*" Then
Set WB = Workbooks.Open(oFile.Path)
'Do whatever you want with your workbook.
WB.Close '(Optional True/False for save changes)
End If
Next oFile
End Sub
Here are 2 sub that I can suggest. Since I don't understand from your question if you want to loop, open and modify the files in a folder, or you want simply to check the files names in a folder, I made 2 sub. One "LoopFilesNamesInFolder" will loop to check the file names without opening the files, and second one "LoopAndOpenFilesInFolder" allows you to open and make changes if you want to the files. You can use any of them based on your needs. Let me know if it helps you
Public Sub LoopFilesNamesInFolder()
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim MyFileName As String
myPath = ThisWorkbook.Path & "\"
'The file name that you are looking for
MyFileName = "*Health*"
myExtension = "*.xls*"
'Current File in loop
myFile = Dir(myPath & myExtension)
Do While myFile <> vbNullString
If myFile Like MyFileName Then
'You can also use something like
'If LCase(myFile) Like LCase(MyFileName) Then
'If you want to make it not case sensitive
'Your code
Else
'Your code
End If
'Get next file name
myFile = Dir
Loop
End Sub
Public Sub LoopAndOpenFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim MyFileName As String
'if you want to Optimize code keep the following 3 instructions
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
myPath = ThisWorkbook.Path & "\"
'The file name that you are looking for
MyFileName = "*Health*"
myExtension = "*.xls*"
'Current File in loop
myFile = Dir(myPath & myExtension)
Do While myFile <> vbNullString
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'You can add a DoEvents here to give time to Excel to open the workbook before moving fwd
DoEvents
'Do Whatever you want to do
If wb.Name Like MyFileName Then
'You can also use something like
'If LCase(wb.Name) Like LCase(MyFileName) Then
'If you want to make it not case sensitive
'Your Code
Else
'Your Code
End If
'If you want to save your changes, replace the False by True to Save and Close Workbook
wb.Close SaveChanges:=False
'You can add a DoEvents here as well to give time to your Excel to close before moving to next one
DoEvents
'Get next file name
myFile = Dir
Loop
'Reset Settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Background:
I receive a daily sales files that I would like to import into access automatically. They are currently saved to a specific folder with a consistent naming convention. I don't review these files everyday and would like to make the import process a push button procedure. There are other files in the folder that I don't need, so I can't just import the entire file.
File Naming Convention: DAILY.SALES.20160611
(the 20160611 is the Year - 2016, Month - June, and Day 11th)
Help needed:
I can import all the files, but I can't figure out how to specify only those files that begin with "Daily.Sales". Below is the code I have that can import everything without specifying. My assumption is that it has something to do with the path or strFile, but none of the variations that I've tried has worked.
It would be nice if the code could actually check if the file has already been uploaded before uploading it, however, if I have to delete the table after each use and re-upload everything that is still easier.
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
DoCmd.SetWarnings False
path = "C:\Desktop\Test\"
Dim objXL As Object
Dim wb As Object
Set objXL = CreateObject("Excel.Application")
strFile = Dir(path & "*.xls")
While strFile <> ""
Set wb = objXL.Workbooks.Open(path & strFile)
If wb.Sheets(1).Range("A1") <> "No Data" And wb.Sheets(1).Range("A1") <> "" Then
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
End If
strFile = Dir()
Debug.Print strFileList(intFile)
wb.Close False
Set wb = Nothing
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
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Stage", filename, False
Call Format_Staging_Table
Call Copy_from_Stage_to_Master
Call Clear_Staging_Table
Next intFile
DoCmd.SetWarnings True
You can ignore the Call pieces, they are to format the data once I get it in...
Thanks for any help or advice that anyone might be able to provide!
Ok, I just answered a question like this 1 minute ago. I think you should take a look at this link.
http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWktsSepTbl
Just modify that to suit your needs... Basically...change the path and folder to match your file name...
Overall Goal:
Pull all files from folder > format files in staging table > copy staging table to master table > kill staging table > rinse and repeat until all files have been taken from folder, formatted and put into the master table.
Issue:
I have apparently not taken into account that some of the files sent to me will have blank worksheets (rather they may have a value that says "No Data" in cell A1). When my macro hits the "No Data" or blank sheet I get a Null error (94).
What I've tried:
strF1Data = Nz(!ref_val)
strF1Data = Nz(!ref_val,"")
Suspicions:
I think I can update the SQL UPDATE line to allow Nulls, but I feel like a more efficient solution would be to skip if null. However I have tried modifying the Do Until statement and had no luck...
Possibly Worth Mentioning:
The files have multiple worksheets. I learned this the hard way in finding this error on a random worksheet between several other worksheets that did have data.
Code: (to help save some space, I'm only giving the call files bit and formatting piece, I don't think the other pieces will be of any use. However if you would like them then let me know.)
The overall macro (see next code sections for piece with error):
Sub Pull_File_into_Staging_Table()
'Process:
'1 - Loop through all files saved to specified folder making an internal list of the files
'2 - Paste one files content to staging table at a time
'3 - Format the information in the staging table
'4 - Copy formatted staging table to 1Compare Table (master table)
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
DoCmd.SetWarnings False
path = "C:\Users\USER\Desktop\Test\"
Dim rs As DAO.Recordset ' Moved from below
Dim db As DAO.Database
Set db = CurrentDb
'Loop through the folder & build file list
strFile = Dir(path & "*.xls")
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
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Stage", filename, False
Call Format_Staging_Table
Call Copy_from_Stage_to_Master
Call Clear_Staging_Table
Next intFile
DoCmd.SetWarnings True
End Sub
The piece with the issue:
Sub Format_Staging_Table()
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
DoCmd.SetWarnings False
path = "C:\Users\USER\Desktop\Test\"
Dim rs As DAO.Recordset ' Moved from below
Dim db As DAO.Database
Set db = CurrentDb
CurrentDb.Execute ("ALTER TABLE Stage ADD COLUMN UPC Text, SR_Profit_Center Text, SR_Super_Label Text, SAP_Profit_Center Text, SAP_Super_Label Text;")
CurrentDb.TableDefs("Stage").Fields("F1").Name = "ref_val"
Dim ref_val As String
Set rs = db.OpenRecordset("SELECT TOP 1 ref_val FROM Stage;", dbOpenDynaset)
ref_val = rs.Fields(0).Value
rs.Close
db.Execute "DELETE FROM [Stage] WHERE ref_val = '" & ref_val & "';"
Const YOUR_TABLE_NAME As String = "Stage"
Dim SQL_UPDATE_DATA As String
SQL_UPDATE_DATA = "SELECT *, ';' & '" & ref_val & "' FROM [" & YOUR_TABLE_NAME & "] WHERE SR_Profit_Center Is Null"
Dim strF1Data As String
Dim varData As Variant
Set rs = CurrentDb.OpenRecordset(SQL_UPDATE_DATA)
With rs
Do Until .EOF
strF1Data = !ref_val
varData = Split(strF1Data, ";")
If UBound(varData) = 4 Then
.Edit
!ref_val = ref_val
!UPC = varData(0)
!SR_Profit_Center = varData(1)
!SR_Super_Label = varData(2)
!SAP_Profit_Center = varData(3)
!SAP_Super_Label = varData(4)
.Update
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
End Sub
Also I'm aware of the extra variable pieces, I will clean it up once I get it working.
File Examples:
Working File:
CE16041901
00791558441123;US1K100017;CGR;US1K100001;UNKNOW
00791558442328;US1K100017;CGR;US1K100001;UNKNOW
00791558440720;US1K100017;CGR;US1K100001;UNKNOW
00791558444629;US1K100017;CGR;US1K100001;UNKNOW
00791558440522;US1K100017;CGR;US1K100001;UNKNOW
00791558443325;US1K100017;CGR;US1K100001;UNKNOW
Not Working File:
CE16042001
00791558334128;US1K100017;CGR;US1K100001;UNKNOW
00791558159523;US1K100017;CGR;US1K100001;UNKNOW
00602547736604;US1A100018;UR;US1A100018;US-RU
I appreciate any help. I ran with this as far as I could, but I am still very much a novice when it comes to access and vb. If you need more information or clarification please let me know and I'll do my best to provide/explain.
No need to touch the staging table functions. Simply conditionally populate the strFileList array depending if Excel workbooks' first sheet contains No Data or empty cell. Recall Access VBA has complete access to all Excel objects via COM interface or Excel VBA reference and so can iteratively open workbooks. Hence, adjust your While/Wend loop accordingly:
Sub Pull_File_into_Staging_Table()
'...same code...
Dim objXL As Object
Dim wb As Object
Set objXL = CreateObject("Excel.Application")
strfile = Dir(Path & "*.xls")
While strfile <> ""
Set wb = objXL.Workbooks.Open(Path & strfile)
If wb.Sheets(1).Range("A1") <> "No Data" AND wb.Sheets(1).Range("A1") <> "" Then
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strfile
End If
strfile = Dir()
wb.Close False
Set wb = Nothing
Wend
'...
Need help with the Access VBA
I am trying to import spreadsheets from excel into access. Once it is imported it will be appended into a different table and the import table will be deleted so that i can then import a new spreadsheet. However i have error when appending i need to append the entire table because i will not always know the header from the spreadsheet and how many their are.
Please Help. Below is the code i have been work on.
Module-
Option Compare Database
Function selectFile()
Dim fd As FileDialog, fileName As String
On Error GoTo ErrorHandler
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
fileName = fd.SelectedItems(1)
End If
Else
'Exit code if no file is selected
End
End If
'Return Selected FileName
selectFile = fileName
Set fd = Nothing
Exit Function
ErrorHandler:
Set fd = Nothing
MsgBox "Error " & Err & ": " & Error(Err)
End Function
VBA -
Private Sub cmdImportNoDelete_Click()
'Unset warnings
DoCmd.SetWarnings False
'Import spreadsheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Import", selectFile, True
'SQL append statement, Needs to append entire table (must be able to append multiply table with different headers
DoCmd.RunSQL "INSERT INTO Tbl_ImportDump * FROM Import"
'SQL delete Table
DoCmd.DeleteObject acTable, "Import"
DoCmd.SetWarnings True
End Sub
Tbl_ImportDump must exist. If it doesn't already, create it:
DoCmd.RunSQL _
"CREATE TABLE Tbl_ImportDump (Col1 Col1DataType, Col2 Col2DataType, etc)"
Then after importing your spreadsheet (as table Import, as you've already done), get the column names in the Import table, and put these into the insert statement:
dim ImportCols as String: ImportCols = ""
dim ii as long
dim rs as Recordset
rs.OpenRecordset "SELECT TOP 1 * FROM Import"
for ii = 0 to 2
ImportCols = ImportCols & "," & rs.Fields(0).Name
next
importCols = mid(importCols, 2)
DoCmd.RunSQL _
"INSERT INTO Tbl_ImportDump (Col1, Col2, Col3) " & _
"SELECT " & importCols & " FROM Import"
I have a large amount of csv files that I need in .xls format. Is it possible to run a batch conversion with a macro or best done with another language?
I have used this code http://www.ozgrid.com/forum/showthread.php?t=71409&p=369573#post369573 to reference my directory but I'm not sure of the command to open each file and save them. Here's what I have:
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim CSVCount As Integer
Dim myVar As String
myVar = FileList("C:\Documents and Settings\alistairw\My Documents\csvxlstest")
For i = LBound(myVar) To UBound(myVar)
With wb
Application.Workbooks.OpenText 'How do I reference the myvar string ?
wb.SaveAs '....
End With
Next
End Sub
Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant
Dim sTemp As String, sHldr As String
If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
sTemp = Dir(fldr & fltr)
If sTemp = "" Then
FileList = Split("No files found", "|") 'ensures an array is returned
Exit Function
End If
Do
sHldr = Dir
If sHldr = "" Then Exit Do
sTemp = sTemp & "|" & sHldr
Loop
FileList = Split(sTemp, "|")
End Function
Edit: The files are .txt files formatted as csv
By combining the code given by Scott Holtzman and 'ExcelFreak', the conversion works quite well. The final code looks something like this:
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "U:\path\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
Opening the converted .xls file throws a warning everytime:
"The file you are trying to open, 'filename', is in a different format than specified by the file extension. Verify that the file is not corrupted and is from a trusted source before opening the file. Do you want to open the file now?"
Clicking Yes then opens the .xls file.
Is there a way to get rid of this warning message? Excel throws a warning everytime the .xls file is opened.
In a lot less lines of code, this should get you what you want. However, I will say this may not be the fastest way to get it done, because you are opening, saving, and closing the workbook every time. I will look for a faster way, but I forget the method off the top of my head.
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
.Close True
End With
Set wb = Nothing
Loop
End Sub
** UPDATE **
you need the proper fileformat enumeration for a .xls file. I think its 50, but you can check here Excel File Type Enumeration, if it's not.
The Code of Scott Holtzman nearly did it for me. I had to make two changes to get it to work:
He forgot to add the line that makes our loop continue with the next file. The last line before the Loop should read
strFile = Dir
The Workbooks.Open method did not read my CSV files as expected (the whole line ended up to be text in the first cell). When I added the parameter Local:=True it worked:
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
This works properly at least on Excel 2013. Using FileFormat:=xlExcel8 parameter instead of the filetype tag 50 creates files that open without security nags.
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\temp\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
This was a good question and I have found in the internet several answers. Just making very small changes (I couldn't edit any of the codes already published) I could make things work a bit better:
Sub CSV_to_XLSX()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\Users\acer\OneDrive\Doctorado\Study 1\data\Retest Bkp\Day 1\Sart\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xlsx"), 51
.Close True
End With
Set wb = Nothing
strFile = Dir
Loop
End Sub