Importing .csv to MS Access. "AtEndOfStream" doesn't read last line - vba

I want to import some data from a .csv file into a MS Access database via VBScript.
Sub CSVImport
connStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=P:\somedatabase.accdb"
'Define object type
Set objConn = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
'Open Connection
objConn.open connStr
objRecordSet.Open "SELECT * FROM SomeTable", _
objConn, adOpenStatic, adLockOptimistic
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("P:\someFile.csv")
Do Until objFile.AtEndOfStream
strVKBL_Stamm = objFile.ReadLine
arrVKBL_Stamm = Split(strVKBL_Stamm, ";")
objRecordSet.AddNew
objRecordSet("FirstName") = arrVKBL_Stamm(0)
objRecordSet("LastName") = arrVKBL_Stamm(1)
objRecordSet("Date") = arrVKBL_Stamm(...)
objRecordSet("Type") = arrVKBL_Stamm(11)
Loop
Set objRecordSet = Nothing
Set objFSO = Nothing
Set objFile = Nothing
Set objConn = Nothing
End Sub
This script gets all the data out of my CSV file but it does miss the last line. When I hit return twice (once doesn't suffice) at the end of the .csv all of my data gets imported.
My backup plan is to change the AtEndOfStream bit to something like
If arrVKBL_Stamm(0) = 0 Then
Exit Do
and add a zero to the file. Problem is, the .csv is a report, exported from SAP (which is - afaik - unable to export to MS Access itself), so that part would need another script or has to be done by hand.
Does anyone have a clue or give me a hint how to solve this?

I tried this code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("D:\myfile.csv", 1)
Do Until objFile.AtEndOfStream
S = objFile.ReadLine
Debug.Print S
Loop
objFile.Close
in VBA and it printed all lines of my CSV file, even if the last line doesn't end with a CrLf.
I'm pretty sure the reason is: your objRecordSet.AddNew is missing an objRecordSet.Update.
Apparently, if you call .AddNew after the previous .AddNew, the previous record is saved nevertheless.
But objRecordSet.AddNew followed by Set objRecordSet = Nothing doesn't save the last record.
Solution: add objRecordSet.Update as last command in the loop.

SAP uses a standard database engine in the back end. You can set up linked tables that pull directly from SAP in to Access. No export\import. It's a live table.
SEE HERE:
How do I configure my Microsoft Access database to pull source data directly from SAP BW?
https://archive.sap.com/discussions/thread/1382889

Related

Exporting query from MS Access to CSV, columns with lengthy text with linebreaks get cuts off

I have a MS Access file and it has a form with a button which export a named query to a CSV file. When i open the CSV to Excel, a column with lengthy text with line breaks get cuts off. When i tried to copy and then paste special as CSV on the Excel it turns out to be fine.
Here is my VBA code
Public Sub exportQuery(exportSQL As String)
Dim db As DAO.Database, qd As DAO.QueryDef
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
Set db = CurrentDb
'Check to see if querydef exists
For i = 0 To (db.QueryDefs.Count - 1)
If db.QueryDefs(i).Name = "tmpExport" Then
db.QueryDefs.Delete ("tmpExport")
Exit For
End If
Next i
Set qd = db.CreateQueryDef("tmpExport", exportSQL)
'Set intial filename
fd.InitialFileName = "export_" & Format(Date, "mmddyyy") & ".csv"
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "tmpExport", fd.SelectedItems(1), False
End If
End If
'Cleanup
db.QueryDefs.Delete "tmpExport"
db.Close
Set db = Nothing
Set qd = Nothing
Set fd = Nothing
End Sub
And this for command button to call the function
Private Sub Command0_Click()
Dim queryStr As String
'Store Query Here:
queryStr = "SELECT [Name],[Notes] FROM [GetListForUpload]"
Call exportQuery(queryStr)
End Sub
Can someone help me with this?
I solved my own problem haha! So i just want to share this for any other who stumbled from this situation. Their's this hidden system objects that you want to show up in navigation options. So first is you check to show the hidden system objects in the navigation options and you will see tables that is greyed out ex.(MSysIMEXColumns, MSysIMEXSpecs) then create a specification. Open the table MSysIMEXColumns, you will see all of the field names on the specification you've created. So on my part i have Notes column which contains lenghty texts with linebreaks. In the MsysIMEXColumns table, I changed the DataType for the fieldname Notes from 10 (Text) to 12 (Memo) and voila. No lenghty texts get cuts off or truncated anymore :)
PS: If you have more than 1 specifications created please identify the specid first from MSysIMEXSpecs and then check it in MSysIMEXColumns before you changed anything for not to get confused.

Creating a Button in Excel, that calls upon a created Access query

Is there a way to create a button in Excel that runs a query, that is already created, in Access, and then updates the excel spreadsheet using the data from the query? I've searched the web for directions on how to do this, but have only found answers that create a button in Excel, that only runs a query in Excel, not Access. I am assuming this will be done by coding, upon click, in VBA, but have yet to find anything that does this. So... Is it possible? If so, how?
Okay, so I have kind of updated this with question, because I sort of used both options made. So I first created a Function in a Standard Module (Because we may use this later for another sheet in the workbook, and we didn't want to duplicate work):
Function GetSqlServerData(sQuery As String, sRange As Range)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
' Create the connection string.
sConnString = "NMS"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute(sQuery)
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets(3).Range("A2").CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Function
Then I tried to use said function:
Sub GetPermits()
Dim sQuery As String
Dim sRange As Range
Set sQuery = "Select * From Customer;"
Set sRange = Sheets(3).Range("A2")
GetSqlServerData(sQuery, sRange)
End Sub
But it gives me an error right at the spot where is actually use the function. I don't need it to go to a MsgBox, and I don't need it to print it out, all I need is for it to put in the data into the sheet noted on the function call. BTW, the function needs some tweeking, I know. Right now, I just need it to call the darn thing, lol.
Here is a Screen Shot of the error message: If you cant see it, it says, "Compile Error: Expected:=" and it highlights the "GetSqlServerData(sQuery, sRange)" in red. So it must have something to do with that. I just can't figure out what it is.
Screenshot of the error message
Dependent on your requirements, you could have this without VBA in a quicker and more reliable way, to have a table that is pointed at your query, that updates when you click Refresh.
To do so, in Excel navigate to Data > From Access.
From here, navigate to your database with the saved query, and when asked to select a table, you can select the query instead.
You can also write your own SQL query for Excel to execute against the database instead.
You can edit the connection properties to refresh when the workbook is opened, or refresh when every 60 minutes for example, or you could turn it all off, and allow the user to hit 'Refresh' in Excel itself.
Alternatively, you could setup a button that runs the refresh table command against the linked table, and this would do the same
Private Sub CommandButton1_Click()
ActiveWorkbook.RefreshAll
End Sub
Good luck.
As an example for a solution with VBA using ADODB one could use the following function to connect to the database.
Function ConnectToDB(ByVal fileName As String)
Dim conn As New ADODB.Connection
If Dir(fileName) = "" Then
MsgBox "Could not find file " & fileName
Exit Function
End If
Dim connectionString As String
' https://www.connectionstrings.com/access/
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" _
& fileName & ";Persist Security Info=False;"
conn.Open connectionString
Set ConnectToDB = conn
End Function
And if you want to copy data from the database one could use the following code. You need to have a sheet with the codename shRepAllRecords
Option Explicit
Sub ReadFromDB()
' Get datbase name
Dim dbName As String
dbName = <fule filename of the database>
' Connect to the databse
Dim conn As ADODB.Connection
Set conn = ConnectToDB(dbName)
' read the data
Dim rs As New ADODB.Recordset
Dim query As String
' First example to use an SQL statement
' query = "SELECT * From CUSTOMER"
' Second example to use a query name defined in the database itself
query = "qryCustomer"
rs.Open query, conn
' shRepAllRecords is the codename of the sheet where the
' data is written to
' Write header
Dim i As Long
For i = 0 To rs.Fields.Count - 1
'shRepAllRecords.Cells(1, i + 1).Value = rs.Fields(i).Name
shRepAllRecords.Range("A1").Offset(0, i) = rs.Fields(i).Name
Next i
' Write Data
shRepAllRecords.Range("A2").CopyFromRecordset rs
shRepAllRecords.Activate
' clean up
conn.Close
End Sub
So I was finally able to figure out the issue. I was not putting "Call" in front of the function call. Once I did that, it accepted it. Thanks for all the assistance! The final answer was close to what Storax gave above. So I credited him with the answer. Thanks again!

Alternative to Access app

A subroutine in Excel VBA runs a macro in an Access database. This exports a table in the db to a .csv file. I have Access installed on my PC but other people that will also need to use this do not, so see an error message.
Is there any other method I can use to run a macro from Access besides creating an object as in my code below, maybe something like a ADODB?
My Excel VBA code:
Dim accApp As Object
Set accApp = CreateObject("Access.Application")
dbPath = ThisWorkbook.Path & "\Database\STORE_TOC_FRONTEND.accdb"
accApp.OpenCurrentDatabase dbPath
accApp.DoCmd.RunMacro "Create SS Upload"
Set accApp = Nothing
Yeah make an Adodb connection object, and a Adodb recordset object. Untested code below.
set conn = CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0" 'Or Microsoft.ACE.OLEDB.12.0 for 2007+ version of access
conn.Open "c:/webdata/northwind.mdb" 'path to your db
set objRecordset=CreateObject("ADODB.Recordset")
objRecordset.open("Select * from SomeTable",conn,0,3,1)
'do you work here, something like a loop for each field and for each row
objRecordset.close
conn.close

Open field in protected, shared Excel workbook

I have a shared, protected workbook that has a button to bring up a search form. There are two fields on this form, txtYear and cbxRegion, that I need enabled. Whenever I try to open the fields, it works until I exit Excel.
I have tried unprotecting the workbook, unsharing it, and commenting out any reference in the VBA to reprotecting the form. And still, even the edited VBA reverts back to the original.
This is the section of code referring to the form I need enabled. Any assistance would be greatly appreciated. I'm using Excel 2010.
Private Sub UserForm_Initialize()
Dim strDb As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim row As Integer
Dim AccessVersionID As String
cbxRegion.Value = Worksheets("Parameters").Cells(5, 14)
Me.txtYear = Worksheets("Parameters").Cells(4, 7)
Me.chkBoth = Worksheets("Parameters").Cells(9, 2)
Me.chkConsultant = Worksheets("Parameters").Cells(7, 2)
Me.chkInHouse = Worksheets("Parameters").Cells(8, 2)
'Set region values
'Open connection
'Select Case SysCmd(acSysCmdAccessVer)
'Case 11: AccessVersionID = "2003"
'End Select
'If AccessVersionID = "2003" Then
' strDb = Worksheets("Parameters").Cells(17, 2).Value 'This will reference the path
'Else
strDb = Worksheets("Parameters").Cells(18, 2).Value
'End If
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDb & ";"
Set rs = New ADODB.Recordset
'Get recordset
With rs
Set .ActiveConnection = cn
.Open "Select * From LookupRegion"
.Requery
End With
'Add regions
row = 0
With rs
.MoveFirst
Do Until .EOF
cbxRegion.AddItem ![region]
cbxRegion.list(row, 1) = ![RegionName]
row = row + 1
.MoveNext
Loop
End With
'Close the recordset
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I managed to get it to work. In order, I:
Unshared the workbook
Unprotected the workbook
Saved, closed, and reopened the workbook to make sure the settings stayed
Enabled the fields
Saved, closed, and reopened the workbook to make sure the settings stayed
Protected the workbook
Shared the workbook (as required by the specifications I was given, I would rather not share it but it really isn't my call here)
Saved, closed, and reopened the workbook to make sure the settings stayed
And now it works exactly as I need it to.
As far as I am concerned, the best advice anyone can give you for a shared workbook is: don't use them.
Shared Workbooks are impossible to troubleshoot. Their aberrant behaviour cannot be fixed. They don't follow any logic. Once a shared workbook starts acting up and behaving strangely, you have reached the inevitable end stage. Nothing can be done to fix it. The behaviour is not necessarily reproducible.
If you need simultaneous multi-user write access to a dataset, then Excel is the wrong tool. Use a database.
Don't use shared workbooks.

overwrite a csv file using vba

There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub