I have around 20 linked tables in Access sourcing from .csv files, with the first row used as table headers. However, I can’t seem to keep the headers any time I update source path, so I have to manually delete and relink them every single time and it’s been painful.
Any idea how to keep the table format and properties after source path change?
Can use VBA to modify links. Example code:
Dim td As TableDef
Dim db As DAO.Database
Dim strOld As String
Dim strNew As String
'replace the following strings as needed
strOld = "C:\Users\June\Forums"
strNew = "C:\Users\June"
Set db = CurrentDb
For Each td In db.TableDefs
If InStr(td.Connect, strOld) > 0 Then
Debug.Print td.name
Debug.Print "Old Link: " & td.Connect
td.Connect = Replace(td.Connect, strOld, strNew)
td.RefreshLink
Debug.Print "New Link: " & td.Connect
End If
Next td
db.TableDefs.Refresh
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.
I'm attempting to create a macro that based on a user input (on an excel sheet) will pull data from a query I made in Access. In order for it to pull only the applicable lines (rows) of data it needs to edit the WHERE statement accordingly. I have adapted the following code from a previous question but I am running into issues when I try to replace the SQL.
Private Sub CommandButton4_Click()
Const DbLoc As String = "MYfilepath"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, SQL As String, recCount As Long
Set wb1 = Workbooks("mytool.xlsm")
Set ws1 = wb1.Sheets("Inputs")
Set ws2 = wb1.Sheets("raw")
Set db = OpenDatabase(DbLoc)
Set userinput = ws1.Range("D6")
SQL = "SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID"
SQL = SQL & "FROM Dock_Rec_Problems;"
SQL = SQL & "WHERE [Dock_Rec_Problems_DGID] =" & userinput
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Not found in database", vbInformation + vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Exit Sub
End Sub
Let me know if there is anything I can clear up...thanks!
Original Query SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code,
Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP,
Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number,
Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description,
Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail,
Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems;
Single input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000"));
Double input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000")) OR (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323012"));
Because the size of your user input is open-ended, consider using a temp table saved in MS Access with exact structure as your query (can be built with: SELECT * INTO temp_table FROM myquery). Then, with each call of the Excel macro:
Clean the temp table out with DELETE.
Iterate through the user input Excel range of cells to append needed rows to table with INSERT INTO...SELECT.
Create recordset from temp table.
And once again, here is a prime use case for SQL parameterization especially since the query receives user input. A clever, malicious user can potentially clean out your database! But at the very least, code is arguably more maintainable. Because you are using DAO, consider QueryDefs to bind parameter value to a prepared, saved query and then bind into a recordset.
SQL (save as an MS Access stored action query)
PARAMETERS [userparam] TEXT(255);
INSERT INTO Excel_Table (Merch_Name, Vendor_Error_Code, DC, Vendor_ID_IP,
Vendor_Name, PO_Number, SKU_No, Item_Description,
Casepack, Retail, Num_Of_Cases, Dock_Rec_Problems_DGID)
SELECT d.Merch_Name, d.Vendor_Error_Code, d.DC, d.Vendor_ID_IP,
d.Vendor_Name, d.PO_Number, d.SKU_No, d.Item_Description,
d.Casepack, d.Retail, d.Num_Of_Cases, d.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems d
WHERE d.[Dock_Rec_Problems_DGID] = [userparam];
VBA
...
Dim qdef As DAO.QueryDef
Dim cel As Range
Set qdef = db.QueryDefs("mySavedQuery")
' CLEAN OUT TEMP EXCEL TABLE
db.Execute "DELETE FROM Excel_Table"
' ITERATIVELY APPEND TO EXCEL TABLES
For Each cel In userinput.Cells
qdef!userparam = cel.Value ' BIND PARAM
qdef.Execute dbFailOnError ' EXECUTE ACTION
Next cel
' OPEN RECORDSET TO TABLE
Set rs = db.OpenRecordset("Excel_Table", dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Recieving problem not found in database", vbInformation+vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
.......
There are a few problems with the code you've displayed. For instance, the strNewFields variable is attempted to be used, before you've set it to anything, here:
strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
At this point strNewFields is totally blank, but you're trying to do a replace.
I would suggest:
Change you WHERE_FIELDS Const from
Const WHERE_FIELDS As String = "WHERE " _
& "(((Dock_Rec_Problems.Dock_Rec_Problems_DGID) = <INSERT FIELDS>)); "
to
Const WHERE_FIELDS As String = "WHERE " _
& " [Dock_Rec_Problems].[Dock_Rec_Problems_DGID] IN (<INSERT FIELDS>); "
I find this easier to read then all the nested brackets, it removes the equals sign in preference of the IN() statement.
Now you want to populate the strNewFields variable with whatever inputs they gave you. Probably using a Do While Loop to iterate through the INPUTS. Each input is added to the strNewFields variable something like this.
Dim rs as Recordset
Set RS = currentdb.mydataset ' You need to modify this line
rs.Open
strNewFields = strNewFields & "'" & rs("InputFieldName") & "'"
rs.MoveNext
Do While rs.EOF = False
strNewFields = strNewFields & ",'" & rs("InputFieldName") & "'"
Loop
strNewFields = StrNewFields & ")"
Now that you have strNewFields populated you can simply run your replace()
Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
You need to look at the order in which you are setting variables though, as pointed out above, you've got some order of event issues.
Michael
I would like to create a program in Excel that loops through a list of Access databases and writes the VBA that exists in the Access modules. I have found some code that I can run from Access which writes the VBA that exists in the Access modules. I am trying to figure out how to reference the database files from Excel and run the program on each database file. I will probably be able to figure out how to loop through the database files. I just need help with referencing the database file in the below code.
I can open the database with something like this:
Dim cstrDbFile As String = "C:\Database51.accdb"
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
objShell.Run cstrDbFile
I also tried to set up a reference to Access like this:
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase ("C:\Database51.accdb")
I need to figure out how to refer to the Access database in:
Application.VBE.ActiveVBProject.VBComponents
I probably need to figure out how to create a reference to replace ActiveVBProject.
Below is some code I found which writes the contents of VBA modules. I don't remember where I found it.
For Each Component In Application.VBE.ActiveVBProject.VBComponents
With Component.CodeModule
'The Declarations
For Index = 1 To .CountOfDeclarationLines
Debug.Print .Lines(Index, 1)
Next Index
'The Procedures
For Index = .CountOfDeclarationLines + 1 To .CountOfLines
Debug.Print .Lines(Index, 1)
Next Index
End With
Next Component
The following code will let you see Access database objects, but I don't know how to export the code (DoCmd not in Excel?). Your task would be VERY simple to do from Access, so I would reconsider...
Option Explicit
' Add a reference to the DAO Object Library
Sub Read_Access_VBA()
Dim dbs As DAO.Database
Dim ctr As DAO.Container
Dim doc As DAO.Document
Dim iC As Integer
Dim iD As Integer
Dim i As Integer
Dim mdl As Module
Set dbs = DBEngine.OpenDatabase("c:\TEMP\106thRoster.mdb", False, False, _
"MS Access;")
Debug.Print "----------------------------------------"
For iC = 0 To dbs.Containers.Count - 1
Debug.Print "Container: " & dbs.Containers(iC).Name
If dbs.Containers(iC).Documents.Count > 0 Then
For iD = 0 To dbs.Containers(iC).Documents.Count - 1
Debug.Print vbTab & "Doc: " & dbs.Containers(iC).Documents(iD).Name
Next iD
Else
Debug.Print " No Documents..."
End If
Next iC
'Set ctr = dbs.Containers!Modules
dbs.Close
Set doc = Nothing
Set ctr = Nothing
Set dbs = Nothing
End Sub
I was able to find some code that will assist me with my final goal: Exporting MS Access Forms and Class / Modules Recursively to text files?
Below are the most significant lines that will allow me to make progress with the project.
LineCount = oApp.Forms(Name).Module.CountOfLines
FileName = Path & "\" & Name & ".vba"
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, oApp.Forms(Name).Module.Lines(1, LineCount)
Close #F
I've created the following code which I want to use in the future to get a list of all the fields in a table:
Private Sub btnGetFields_Click()
Dim myDBS As Database
Dim fldLoop As Fields
Dim fld As Field
Dim relLoop As Relation
Dim tdfloop As TableDef
Set myDBS = CurrentDb
With myDBS
' Display the attributes of a TableDef object's
' fields.
Debug.Print "Attributes of fields in " & _
.TableDefs("ALT_IDENTIFIER").Name & " table:"
'Error occurs in line below
Set fldLoop = .TableDefs("ALT_IDENTIFIER").Fields
For Each fld In fldLoop
Debug.Print " " & fld.Name & " = " & _
fld.Attributes
Next fld
.Close
End With
End Sub
But I'm getting a Type Mistmatch - Runtime Error 13 back when I run the code.
Why? fldloop is a Fields object - i.e. a collection of field objects right? which is what the TableDefs.Fields procedure returns so why am I getting this error?
Thanks
I was having same issue and i resolved it by changing "Field" to "DAO.Field":
Dim fld As DAO.Field
Maybe it helps another one.
Best regards
Sometimes passing values to their literal types in Access causes these kinds of errors, not sure why, a quick fix is usually to dimension your variable as an open data type instead e.g:
Dim fldloop as object
Otherwise you could re-write this line:
For Each fld In fldLoop
to
For Each fld In .TableDefs("ALT_IDENTIFIER").Fields
and forget dimensioning a separate variable all together
UPDATE:
Perhaps this would be more useful for SQL Server, if you only have access via MS Access then you should be able to use this example by looping through your linked tables and dynamically re-building a a Pass Through Query
What is the equivalent of 'describe table' in SQL Server?
Found the problem: the reason I was getting the error was because I wasn't referring to the exact field. Though I'm still unsure as to why an error was thrown on a Fields object that was assigned a Fields value.
Here's the code:
Dim f As Field
Dim fldTableDef As Field
Dim Rst As DAO.Recordset
Dim numField As Integer
Dim linkedTable As String
linkedTable = "ALT_IDENTIFIER"
Set Rst = CurrentDb.OpenRecordset(linkedTable)
numField = Rst.Fields.Count
'Loop through
Dim index As Integer
For index = 0 To numField - 1
If Rst.Fields(index).Type = dbDate Then
Debug.Print "Field: " & Rst.Fields(index).Name; " = Date/Time" & Rst.Fields(index).Value
End If
Next