I'm trying to set up an automatic process that scans a particular network folder for new CSV files and then appends the data to a table in Access.
A new CSV is placed in the folder everyday and they all have the same naming convention - ClosingPrice_ddmmyy with the date part changing on every file.
What's the most straight forward way to set up such a process?
All suggestions welcome!
Thanks for the reply, Rahul.
I found the following code on another forum that does most of what I want. It imports all the CSVs from within the source folder and adds them to a table within Access. However, in future I just want to add new CSVs that are added to the folder and not all the CSVs every time. Any ideas on how I can change the code to do this?
Thanks,
Sub Import_CSV()
'Modified from WillR - www.willr.info (December 2004)
Const strPath As String = "C:\ImportFolder\" '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 & import to Access
'creating a new table called MyTable
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acImportDelimi, ImportSpec, _
"Raw Data", strPath & strFileList(intFile), -1
'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 Imported"
End Sub
Related
Situation:
I am iterating through an Outlook-Mailbox and downloading all attachments into specific folders. Then I am iterating through the folders and import the CSV-Files into Access.
Problem:
I have the Outlook.MailItem.receiveTime property and the sender's name, which I have got from the File Title. I want to add those two pieces of information to each row of each CSV-File.
Question:
Is there a possibility to add those two columns on import or do I have to open each file and iterate through the content to add them?
Little side question:
Would it be possible to import the files directly from Outlook, meaning, without heaving to save them?
Software and languages I use:
-Access 2013
-Outlook 2013
-VBA
-SQL
Little side Information: I am triggering all of this from an Access Form.
You can loop through all CSV files and import each to a table.
Private Sub Command0_Click()
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 & import to Access
'creating a new table called MyTable
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acImportDelimi, , _
"Test", strPath & strFileList(intFile)
'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 Imported"
End Sub
If you want to download attachment from Outlook, try this.
Private Sub GetAttachments()
Dim ns As Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("MailboxName").Folders("Inbox")
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
FileName = "C:\attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
End If
Next Atmt
Next Item
End Sub
Set a reference to MS Outlook and remember, the "MailboxName" is your email address.
I have over a thousand files to import into a ACCESS database.
Every file needs to be imported into separate ACCESS table.
It needs to support importing this files every day, because, there are polish stocks prices, so every day, around 08 p.m. I'm downloading a *.zip file containing 1000 *.csv files, and I'll need to import them another time, to get today's prices.
I need to have some settings changed, in order to have my data imported correctly.
next thing is:
advanced settings:
how it looks like.
I don't know how to write these advanced changes in the VBA code.
In EXCEL I could record the macro, and then see the syntax, with the settings I have chosen, but is it possible to do the same in ACCESS ?
There are two codes I've found on the internet.
first:
Function Impo_allExcel()
Dim my_file As String
Dim my_path As String
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_csv"
ChDir (my_path) 'why my_path is inside the brackets??
my_file = Dir()
Do While my_file <> "" 'is not empty (<> means not equal to), Excel VBA enters the value into
'this line above doesn't work, when I'm trying to debug it with F8
If my_file Like "*.csv" Then
' this will import ALL the *.CSV files
'(one at a time, but automatically) in this folder.
' Make sure that's what you want.
DoCmd.TransferSpreadsheet acImport, 8, "Contacts_AVDC_NEW", my_path & my_file
' what this above line says ? please explain.
End If
my_file = Dir() ' what it means?
Loop
End Function
second is:
Function Do_Import_from_CSV()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet has field names
blnHasFieldNames = True
' real path to the folder that contains the CSV files
strPath = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_csv"
' Replace tablename with the real name of the table into which the data are to be imported
strFile = Dir(strPath & "*.csv") 'what this line means?
Do While Len(strFile) > 0
strTable = Left(strFile, Len(strFile) - 4)
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir() 'what this means?
Loop
End Function
Could U please briefly explain these codes for me,
tell me what is the difference between them,
and how can I incorporate the settings I need into these codes,
or into the one that suits me better.
thanks a lot.
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
'...
This question is very similar to the previously posted question: Save each sheet in a workbook to separate CSV files
However, my requirements are slightly different in that I need to have the ability to ignore specifically named worksheets (see #2 below).
I have been successful in utilizing the solution posted in this answer: https://stackoverflow.com/a/845345/1289884 which was posted in response to the question above meets almost all of my requirements with the exception of #2 below and #3 below:
I have an excel 2010 workbook that consists of multiple worksheets and I am looking for a macro that will:
Save each worksheet to a separate comma delimited CSV file.
Ignore specific named worksheet(s) (i.e. a sheet named TOC and sheet name Lookup)
Save files to a specified folder (example: c:\csv)
Ideal Solution would additionally:
Create a zip file consisting of all of the CSV worksheets within a specified folder
Any help would be greatly appreciated.
Nick,
Given you expanded on your question with the differences, and the zip part is a significant addon I have outlined a solution below that:
Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
Adds them to a Zip file. This section draws heavily on Ron de Bruin's code here
The code will create the paths under StrMain and StrZipped if they do not already exists
As the ActiveWorkbook gets sub-divided into CSV files the code tests that the ActiveWorkbook is saved prior to proceeding
On (2) I ran across an issue I have seen before in my Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folde where the Shell.Application errored when string variables were passed to it. So I gritted my teeth and added a hardcoding of the earlier paths for Zip_All_Files_in_Folder. I commented out my earlier variable passing to show where I tried this
VBA to save CSVS
Public Sub SaveWorksheetsAsCsv()
Dim ws As Worksheet
Dim strMain As String
Dim strZipped As String
Dim strZipFile As String
Dim lngCalc As Long
strMain = "C:\csv\"
strZipped = "C:\zipcsv\"
strZipFile = "MyZip.zip"
If Not ActiveWorkbook.Saved Then
MsgBox "Pls save " & vbNewLine & ActiveWorkbook.Name & vbNewLine & "before running this code"
Exit Sub
End If
With Application
.DisplayAlerts = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
'make output diretcories if they don't exist
If Dir(strMain, vbDirectory) = vbNullString Then MkDir strMain
If Dir(strZipped, vbDirectory) = vbNullString Then MkDir strZipped
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "TOC", "Lookup"
'do nothing for these sheets
Case Else
ws.SaveAs strMain & ws.Name, xlCSV
End Select
Next
'section to run the zipping
Call NewZip(strZipped & strZipFile)
Application.Wait (Now + TimeValue("0:00:01"))
Call Zip_All_Files_in_Folder '(strZipped & strZipFile, strMain)
'end of zipping section
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = lngCalc
End With
End Sub
'Create the ZIP file if it doesn't exist
Sub NewZip(sPath As String)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
'Add the files to the Zip file
Sub Zip_All_Files_in_Folder() '(sPath As String, ByVal strMain)
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
'Shell doesn't handle the variable strings in my testing. So hardcode the same paths :(
sPath = "C:\zipcsv\MyZip.zip"
strMain = "c:\csv\"
'Copy the files to the compressed folder
oApp.Namespace(sPath).CopyHere oApp.Namespace(strMain).items
MsgBox "You find the zipfile here: " & sPath
End Sub