I have an access database which manipulates data from a Magento e-commerce store, reformats the data and (hopefully!) spits out a CSV file which can then be imported into ebay Turbolister for mass upload to eBay.
I have got as far as creating a query which correctly lays out the data into the format required by Turbolister.
My issues are various (including some which appear to be related to Access' handling of large field contents), however the crux of my problem is that I am struggling to get working a simple script which exports the query results as a properly formatted CSV (including doubling up on double quotes where required inside a text value i.e. if the value itself contains quotes which need to be retained).
The DoCmd.TransferText solution throws an error related to field size ('the field is too small to accept the amount of data you attempted to add') so thats no good.
Has anyone got a good working CSV export routine in VBA that they can suggest?
Cheers
This is an old function I sometimes used to use, it allows you to specify the delimeter, it also checks the data it's outputting and if it can't be evaluated to either a date or a numeric etc, then it uses double quotes:
Public Function ExportTextDelimited(strQueryName As String, strDelimiter As String)
Dim rs As Recordset
Dim strHead As String
Dim strData As String
Dim inti As Integer
Dim intFile As Integer
Dim fso As New FileSystemObject
On Error GoTo Handle_Err
fso.CreateTextFile ("C:\Untitled.csv")
Set rs = Currentdb.OpenRecordset(strQueryName)
rs.MoveFirst
intFile = FreeFile
strHead = ""
'Add the Headers
For inti = 0 To rs.Fields.Count - 1
If strHead = "" Then
strHead = rs.Fields(inti).Name
Else
strHead = strHead & strDelimiter & rs.Fields(inti).Name
End If
Next
Open "C:\Untitled.csv" For Output As #intFile
Print #intFile, strHead
strHead = ""
'Add the Data
While Not rs.EOF
For inti = 0 To rs.Fields.Count - 1
If strData = "" Then
strData = IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
Else
strData = strData & strDelimiter & IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
End If
Next
Print #intFile, strData
strData = ""
rs.MoveNext
Wend
Close #intFile
rs.Close
Set rs = Nothing
'Open the file for viewing
Application.FollowHyperlink "C:\Untitled.csv"
Exit Function
Handle_Err:
MsgBox Err & " - " & Err.Description
End Function
It may need a couple of tweaks as I've taken out some bits which were only relevant to my particular case but this may be a starting point.
Related
I got an .mdb with 200 tables.
I want to write a vba routine that exports data into separate CSV.
On google I've found this code:
Public Sub ExportAllTablesToCSV()
Dim i As Integer
Dim name As String
For i = 0 To CurrentDb.TableDefs.Count
name = CurrentDb.TableDefs(i).name
If Not Left(name, 4) = "msys" And Not Left(name, 1) = "~" Then
DoCmd.TransferText acExportDelim, "", name, _
"c:\exports\" & name & ".csv", _
True
End If
Next i
End Sub
It seems ok but it wants a Export Specification (the parameter after acExportDelim"), this makes the script useless as I don't want to manually create 200 Export Specification.
Any idea?
This worked for me.
Option Compare Database
Option Explicit
Private Sub Command0_Click()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim td As TableDef
Dim d As Document
Dim c As Container
Dim i As Integer
Dim sExportLocation As String
Set db = CurrentDb()
sExportLocation = "C:\all_files\"
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".csv", True
End If
Next td
Set db = Nothing
Set c = Nothing
MsgBox "All database objects have been exported as a csv file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Are you shure you want CSV option? As this format with you can't import tables back to ms access (cause no data schema saved) so you need 200 files with schema. Ok if csv - there is a page https://learn.microsoft.com/en-us/office/vba/api/access.docmd.transfertext. Me, I tryed other more convinient way with XML In case you want to save your tables in convertible format
Dim db As DAO.Database
Dim td As DAO.TableDefs
Set db = CurrentDb()
Set td = db.TableDefs
For Each t In td 'loop through all the fields of the tables
'Ignore any system tables
If Left(t.Name, 4) = "MSys" Then GoTo Continue
DoCmd.OutputTo acOutputTable, t.Name, , _
(strPathAndFileName & t.Name & ".xml"), False
Continue:
Next
`
You will be prompted for any t selected with format confirm
format and schema
So you have to click 3 x 200 times with keys or mouse, then in ~ten minutes work will be done.
I have made some code in VBA to import linked tables into MS-Access. When a table is succesfully added, this should be printed to an output file. When an error occurs, this should be stated instead in the output file. The current output of my code returns both succes and failed line for a table that has an error when added. What do I need to change in the code to only show the succes OR failed line in the output file?
Sub CallAddTable()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim exportLocation As String
Dim exportFile As String
exportLocation = "xxxx"
exportFile = exportLocation & "\yyyy.csv"
Set db = CurrentDb
Set rst = db.OpenRecordset("ToBeAdded")
Open exportFile For Output As #1
Do While Not rst.EOF
On Error GoTo ErrorHandler
Call AddTable(rst!Acces_table_name, rst!Source_table_name)
rst.MoveNext
Print #1, "Succes: " & rst!Acces_table_name & vbTab & rst!Source_table_name
Loop
Close #1
Exit Sub
ErrorHandler:
Print #1, "Failed: " & rst!Acces_table_name & vbTab & rst!Source_table_name & vbTab & Err.Number & vbTab & Err.Description
Resume Next
End Sub
Sub AddTable(AccessTableName As String, SourceTableName As String)
' we will need to create this table using DAO
Dim tdf As DAO.TableDef
' Some variable to make the code more generic
Dim strConnectionString As String
Dim strNameInAccess As String
Dim strNameInSQLServer As String
' set the connection string
strConnectionString = "ODBC;DRIVER={xxxx};Uid=xxxx;Pwd=xxxx;Dbq=xxxxx;Trusted_Connection=Yes"
' specify the tables you want to link. The table can be
' known by a different name in Access than the name in SQL server
strNameInAccess = AccessTableName
strNameInSQLServer = SourceTableName
' Create a table using DAO give it a name in Access.
' Connect it to the Source.
' Say which table it links to in Source.
Set tdf = CurrentDb.CreateTableDef(strNameInAccess)
tdf.Connect = strConnectionString
tdf.SourceTableName = strNameInSQLServer
' Add this table Definition to the collection
' of Access tables
CurrentDb.TableDefs.Append tdf
End Sub
Log file shows first the table as succes and next line it shows same table with failed, if an error occurs.:
"Succes: SOURCETBL_VALUE SOURCETBL.VALUE"
"Failed: SOURCETBL_VALUE SOURCETBL.VALUE 3011 Description."
Based on the comments, changed the code so the errorhandling takes place within the AddTable function. Now only one line per added table is written to the .csv-file.
I have just inherited a database at my new company. Old DB owner left no good documentation and queries very hard to keep track of. Looking for programmatic answer to track sources of fields in every query (what table it come from). Prefer something can be exported to Excel to study, Access visualization is no good. Am familiar with VBA.
This is pretty messy but could save you time collecting each query's SQL code. The following code exports all SQL stored in the QueryDefs collection into a text file. I have it splitting the code with a space delimiter, but a comma might be preferable. The data will not be normalized, I don't have the time to go to that level of complexity. Just make sure to update strPath before you execute. Hopefully this helps.
Sub PullQuerySQL()
Dim dbs As Database
Dim i As Integer
Dim fso As Object
Dim oFile As Object
Dim varParse() As String
Dim element As Variant
Dim strPath As String
strPath = ".txt"
Set dbs = CurrentDb()
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(strPath)
For i = 0 To dbs.QueryDefs.Count - 1
oFile.WriteLine dbs.QueryDefs(i).Name
varParse = Split(dbs.QueryDefs(i).SQL, " ")
For Each element In varParse
oFile.WriteLine element
Next element
Next i
oFile.Close
Set oFile = Nothing
Set fso = Nothing
Set dbs = Nothing
End Sub
I have been through this with many inherited databases. I find it extremely helpful to create an Access table with the fields and the tables/queries that they come from. Try this code below. It will prompt you for the name of the query that you are looking to "map" as I call it. It will then create a new table named "queryName Definitions".
Option Compare Database
Public Sub MapQuery()
Dim strQueryName As String
Dim rst As DAO.Recordset
Dim fld As Field
Dim strSource As String
Dim strField As String
Dim strValue As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim booExists As Boolean
strQueryName = InputBox("Please enter the name of the query that you are looking to map")
Set rst = CurrentDb.OpenRecordset(strQueryName)
On Error GoTo error1
booExists = IsObject(CurrentDb.TableDefs(strQueryName & " Definitions"))
DoCmd.DeleteObject acTable, strQueryName & " Definitions"
continue:
strSQL1 = "CREATE TABLE [" & strQueryName & " Definitions]" & " (FieldName CHAR, SourceName CHAR);"
DoCmd.RunSQL (strSQL1)
DoCmd.SetWarnings False
For Each fld In rst.Fields
strField = fld.Name
strSource = fld.SourceTable
Debug.Print strValue
strSQL2 = "INSERT INTO [" & strQueryName & " Definitions]" & "(FieldName, SourceName) VALUES(""" & strField & """, """ & strSource & """);"
DoCmd.RunSQL (strSQL2)
Next fld
error1:
If Err.Number = 3265 Then
Resume continue
Else
MsgBox Err.Description
End If
DoCmd.SetWarnings True
Exit Sub
DoCmd.SetWarnings True
End Sub
I have a folder that contains 2000 *.csv files. But not all of them are important 4 me. Only 60 of them are important, and I have them listed, by names in access table. there is no header - only file names that need to be read into the single table database.
it looks like this:
these *.mst files are really *.csv files - it will work that way.
I need a VBA procedure, that imports ONLY SELECTED files (these listed in the table) out of this folder into a single access table.
yes, all these files have exactly the same structure, so they can be merged into these access table and that is the goal of this VBA procedure.
this is how every file looks like:
the code I already got just pulls every file from this folder and imports it into the single table in access.
I need it changed to pull only the selected files.
destination table name is: "all_stocks"
Sub Importing_data_into_a_single_table()
Dim start As Double
Dim total_time As String
Dim my_path As String, my_ext As String, my_file As String
Dim FileNum As Integer
Dim DataLine As String
Dim pola() as String
Dim SQL1 As String, file_array() As String
start = Timer
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
my_ext = "*.mst" ' all files with .mst extension.
my_file = Dir(my_path & my_ext) ' take the first file from my_path.
DoCmd.SetWarnings False ' turn off warnings.
Do While my_file <> ""
FileNum = FreeFile()
Open my_path & my_file For Input As #FileNum
Line Input #FileNum, DataLine
' Reads a single line from an open sequential file and assigns it to a String variable.
While Not EOF(FileNum) ' EOF function returns a Boolean value True when the end of a file.
Line Input #FileNum, DataLine
pola = Split(DataLine, ",")
SQL1 = "INSERT INTO Tabela1 (Ticker, day, open, high, low, close, vol) VALUES('" & pola(0) & "', " & _
pola(1) & ", " & pola(2) & ", " & pola(3) & ", " & _
pola(4) & ", " & pola(5) & ", " & pola(6) & ")"
Debug.Print SQL1
DoCmd.RunSQL SQL1
Wend
Close
my_file = Dir()
Loop
DoCmd.SetWarnings True
total_time = Format((Timer - start) / 86400, "hh:mm:ss")
' total_time = Round(Timer - start, 3)
MsgBox "This code ran successfully in " & total_time & " minutes", vbInformation
End Sub
If You could optimize this code to run faster, please be my guest.
Now its importing the data using "Line Input" method, and I've heard, that there are some better ways to do that, but I'm no programmer myself so I'm dependent on Your help my friends.
Thank U for all help and code provided :-)
screen shot 4 for A.S.H
Listing the 2000+ files in the directory, checking if each is listed in the selection table, is not the right approach. It is surely preferable to read the selected files from the table and access them one by one.
The other potential speedup is using the built-in DoCmd.TransferText (as already pointed in other answers). Built-ins are usually very optimized and robust so you should prefer them unless there's a specific reason. Your own tests should confirm it.
Sub Importing_data_into_a_single_table()
Dim my_path As String, rs As Recordset, start As Double, total_time As String
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
DoCmd.SetWarnings False
start = Timer
Set rs = CurrentDb.OpenRecordset("Selected_Files")
Do Until rs.EOF
If Dir(my_path & rs.Fields(0).Value) <> "" Then
DoCmd.TransferText , , "Tabela1", my_path & rs.Fields(0).Value, True
' You could also use your code's loop here; Open my_path & my_file For Input As #FileNum etc..
End If
rs.MoveNext
Loop
DoCmd.SetWarnings True
total_time = Format(Timer - start, "hh:mm:ss")
MsgBox "This code ran successfully in " & total_time, vbInformation
End Sub
I would try using a combination of different method. I will admit I have never interacted with a .mst file in the manner youre using them but I think what IM suggesting will still work perfectly fine.
Use this to check table for file name:
Do While my_file <> "" 'some where after this line
If Isnull(Dlookup("your field name", "your table name", "Field name='" & my_file & "'") = False then
'do stuff b/c you found a match
else
'dont do stuff b/c no match
end if
Then you could use DoCmd.TransferText to import the entire file into the table
Documentation of transfer text method
https://msdn.microsoft.com/VBA/Access-VBA/articles/docmd-transfertext-method-access
I use frequently Excel vba. This bellows is Excel vba method. Compare the speed of this with your method.
Sub OpenCSvs()
Dim sWs As String, Fn As String
Dim Wb As Workbook
Dim start As Double
Dim total_time As String
Dim my_path As String, my_ext As String, my_file As String
start = Timer
my_path = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" 'Source folder.
my_ext = "*.mst" ' all files with .mst extension.
my_file = Dir(my_path & my_ext) ' take the first file from my_path.
Do While my_file <> ""
Fn = my_path & my_file
Set Wb = Workbooks.Open(Fn, Format:=2)
sWs = ActiveSheet.Name
With ActiveSheet
.Rows(1).Insert
.Range("a1").Resize(1, 7) = Array("Ticker", "day", "open", "high", "low", "close", "vol")
End With
ExportToAccess Fn, sWs
Wb.Close (0)
my_file = Dir()
Loop
total_time = Format((Timer - start) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & total_time & " minutes", vbInformation
End Sub
Sub ExportToAccess(myFn As String, sWs As String)
Dim PathOfAccess As String
Dim strConn As String, strSQL As String
PathOfAccess = "C:\Database6.accdb" '<~~ your database path
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & PathOfAccess & ";"
Set cn = CreateObject("ADODB.Connection")
cn.Open strConn
strSQL = "INSERT INTO Tabela1 (Ticker, day, open, high, low, close, vol) select * from [" & sWs & "$] IN '' " _
& "[Excel 8.0;HDR=yes;IMEX=2;DATABASE=" & myFn & "]"
cn.Execute strSQL
End Sub
I need to create an access (2007) table from a text file. I know ahead of time what columns should exist, but from time to time the vendors slip up and submit a text file that contains an incorrect number of columns. So I don't want to specify the columns in advance. I want to load all data as text into whatever columns exist. Then I will do QC.
The columns are pipe delimited and there are over 200 columns per record. There are no column headers, but there is one line of header text for the file, and one line at the end that states how many records there are. There may be anywhere from 1 to over 5,000 records in a text file. Records are identified with CRLF (windows).
Here is what I have so far, and it works (in that it reads the file and places the correct information in the recordset (columns and records), and I can count the number of records), except that the SELECT INTO gives me an error:
Sub OpenTextADO(strFileName As String, strPath As String)
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Dim recs As Integer
Dim strRecord As String
Dim strSQL As String
recs = 0
Set cn = New ADODB.Connection
If Right(strFileName, 3) = "txt" Then
'cn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};" & "DBQ=" & strPath & "\" 'need schema.ini file
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & "\;Extended Properties='text;HDR=No;FMT=Delimited(|)'" 'need schema.ini file
End If
Set rs = New ADODB.Recordset
rs.Open "SELECT * INTO TESTTEXT FROM [" & strFileName & "]", cn, adOpenStatic, adLockOptimistic, adCmdText
'Do Until rs.EOF
' For Each fld In rs.Fields
' strRecord = strRecord & "|" & fld.Value
' Next fld
' strRecord = strRecord & vbCr
' recs = recs + 1
' rs.MoveNext
'Loop
'Debug.Print strRecord
'recs = rs.RecordCount
rs.Close
Set rs = Nothing
MsgBox "Text was opened and there are " & recs & " records in the table."
cn.Close
Set cn = Nothing
End Sub
NOTE: I included both the OLEDB version and the text driver version - they both seem to operate identically. I also created a schema.ini file that looks like this:
[test.txt]
Format=Delimited(|)
ColNameHeader=False
Both drivers seem to need this to desregard column headers, despite the "HDR=No" in the OLEDB version.
The error I get is: "Cannot update. Database or object is read-only".
I appreciate any help.
Could you do a sequential read of the text file, using the count of pipe-delimited fields in the first data line of the file to create a table with the proper number of columns, then just write subsequent lines into that table? I just threw the following together, but it seems to work.
Public Function import_txt_to_db(strFile As String) As Boolean
On Error GoTo ErrHandle
Dim strLine As String
Dim intFileNum As Integer
Dim blnFirstLine As Boolean
blnFirstLine = True
Dim varArray As Variant
intFileNum = FreeFile
Open strFile For Input Access Read As intFileNum
Do While Not EOF(intFileNum)
Line Input #intFileNum, strLine
varArray = Split(strLine, "|")
If blnFirstLine = True Then
'Use count of fields in first line to determine # of columns to create
Dim intColCount As Integer
intColCount = UBound(varArray)
Dim strQry As String
strQry = "CREATE TABLE tblImport ("
Dim intCtr As Integer
For intCtr = 1 To intColCount + 1
strQry = strQry & "[COLUMN_" & intCtr & "] TEXT(255),"
Next intCtr
strQry = Left(strQry, Len(strQry) - 1) & ")" 'get rid of terminal comma
CurrentDb.Execute strQry
blnFirstLine = False
End If
Dim strQry2 As String
strQry2 = "INSERT INTO tblImport VALUES('" & Replace(strLine, "|", "','") & "')"
CurrentDb.Execute strQry2
Loop
Close #intFileNum
import_txt_to_db = True
Exit Function
ErrHandle:
import_txt_to_db = False
End Function
I did a simple test with the folowing five-line text file
Thomas|Jefferson|Virginia
Bill|Clinton|Arkansas
Jimmy|Carter|Georgia
Lyndon|Johnson|Texas
George|Washington|Virginia
After running the code, here's my (simple) table: