Transfer Spreadsheet to Access Database with VBA - vba

I have a browse button and pick and place the file name and path in textbox5. I need to use the same value in my file name but it does not work. It throws:
Run Time Error 2522- The action or method requires a File Name argument
Private Sub Command10_Click()
Dim dbs As DAO.Database
Dim td As DAO.TableDef
Dim fileName As String
'set current database
Set dbs = CurrentDb
Me.Text5 = fileName
DoCmd.TransferSpreadsheet acImport, , "tblS3DimportTemp", fileName, True
MsgBox "Data Uploaded!"
End Sub

Instead of: Me.Text5 = fileName
write:
fileName = Me.Text5
In many programming languages the left variable gets the value of the right one.

Related

How to build a variable filepath as link or path in MS ACCESS using VBA

I have the following problem in MS ACCESS:
Using VBA, a PDF-file is stored in the OneDrive folder and synchronized with Sharepoint. As known, OneDrive is declared as a kind of another drive on all computers in the same way.
After saving, the file is located on computer01 in the folder:
C:\Users\User01\OneDrive - AllFolders\SharedFolder\AllDocs\Doc01.pdf =>( \USER01 )
Now user02 on computer02 who is also connected to the folder wants to open the file via VBA. The path of the file in the shared table field is accordingly:
C:\Users\User01\OneDrive - AllFolders\SharedFolder\AllDocs\Doc01.pdf
Of course User02 can't open the file via VBA, because the path should be:
C:\Users\User02\OneDrive - AllFolders\SharedFolder\AllDocs\Doc01.pdf =>( \USER02 )
For example I tried to use such a path to save the file (this is not the correct Syntax!):
(Environ("USERPROFILE")) & "\OneDrive - AllFolders\SharedFolder\AllDocs\Doc01.pdf
but (Environ("USERPROFILE")) as table.field.value is of course understood as string and not as variable!
How can this problem be solved? Thanks!
my Code:
Option Compare Database
Option Explicit
Public OneDriveDirectory As String
Public Function SetPathToOneDrive() As String
SetPathToOneDrive = (Environ("USERPROFILE")) & "\OneDrive - AllFolders\SharedFolder\AllDocs\"
End Function
Sub SaveDoc()
Dim xSource As String, xDestination As String, xFilename As String
Dim FSO As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
OneDriveDirectory = SetPathToOneDrive
xFilename = "Doc01.pdf"
xSource = (Environ("USERPROFILE")) & "\" & xFilename
xDestination = OneDriveDirectory & xFilename
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDocLinks", dbOpenDynaset)
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
Call FSO.CopyFile(xSource, xDestination)
With rs
.AddNew
.Fields("fldDocPath") = xDestination
.Update
End With
rs.close
db.close
End Sub
With
SetPathToOneDrive = Environ$("%UserProfile%") & "\OneDrive - All Folders\SharedFolder\AllDocs\"
you should get the correct path.
Are you sure the path is correct? The default would be something like C:\Users\username\OneDrive\...
Depending on the environment it's probably not a good idea to store absolute filepaths in the database. I tend to save only the filename and build the path together in VBA, often using values grabbed from a config-table or -file.

Keep VBA Function Value in Sub Routines

I have a little problem which I don't know how to solve. I have 2 functions which allows my user to select a template file and a folder the goal is for me to keep the location of my template file and folder path in order to use it for a record set but only problem in the subroutines the values of those paths are pass as soon as I'm done selecting them so I can use them so this is my code
Function SaveExcelDialog() As String
Dim strSelectedFolder As String
Dim strGetFolder As String
'Choosing the location of the folder where i will save all my recordset
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder" 'window title
.AllowMultiSelect = False 'avoiding multiple selection
.Show
strSelectedFolder = .SelectedItems.Item(1) 'taking the selected path folder
End With
GetFolder = strSelectedFolder 'returning the path of the folder
End Function
Public Function ChooseTemplateFile() As String
' my variables
Dim strSelectedTemplateFile As String
Dim strTemplatePath As String
'selecting a template file
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select a Template File" 'window title
.AllowMultiSelect = False 'avoiding multiple selection
.Filters.Add "Classeur Excel", "*.xls; *.xlsx; *.xlsm" 'filter all the file that are allow to be choosen
.Show
'storing the path of my excel file
TemplateFile = .SelectedItems.Item(1) 'keeping the path
End With
strTemplatePath = strSelectedTemplateFile 'returning the path string value
End Function
Those two examples work but, the problem I encounter is in my sub routine. As soon as I call my function and the function has been executed the value of those two function are not kept and I can't use those variable later on when I need them .
Private Sub Run_Click()
'My Data Variables
Dim strCountry, strSelectedYear, strLink, strCountryLink, strDomain, strDomainLink, strDateLink, DOsSQL As String
Dim iSelectedYear As Integer
Dim strGetFolder, strTemplatePath As String
Dim i As Long
'Variables for query
Dim qdf As DAO.QueryDef
Dim qdfDOs As DAO.QueryDef
Dim rs As DAO.Recordset
Dim rsDOs As DAO.Recordset
strTemplatePath = ChooseTemplateFile() ' value are not kept they are erase as soon as i go to the next line
strGetFolder = SaveExcelDialog() ' value are not kept they are erase as soon as i go to the next line
'taking the value of the file and the folder picked
Dim db As DAO.Database
Dim arrReports(4, 3) As String
Dim strReportTitle As String....
The reason your values are disappearing is that you are assigning the result of the function to your variable, but you are not returning any result from your functions.
Instead, it looks like you're trying to assign values to the outer variables from inside the functions.
This could work with a few modifications, but it is more usual (and safer) to do the following:
Function SaveExcelDialog() As String
'Choosing the location of the folder where i will save all my recordset
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder" 'window title
.AllowMultiSelect = False 'avoiding multiple selection
.Show
'To return a value from a function, assign it to the function's name.
SaveExcelDialog = .SelectedItems.Item(1)
End With
End Function
Public Function ChooseTemplateFile() As String
'selecting a template file
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select a Template File" 'window title
.AllowMultiSelect = False 'avoiding multiple selection
.Filters.Add "Classeur Excel", "*.xls; *.xlsx; *.xlsm" 'filter all the file that are allow to be choosen
.Show
'Again, let's just assign the result to the name, in order to
'return the value.
ChooseTemplateFile = .SelectedItems.Item(1)
End With
End Function
If you like, you can write a test procedure to make sure your values get stored in the variables.
Public Sub TestFilePickers()
Dim strGetFolder, strTemplatePath As String
strTemplatePath = ChooseTemplateFile()
strGetFolder = SaveExcelDialog()
Debug.Print(strTemplatePath)
Debug.Print(strGetFolder)
End Sub

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.

Access VBA - Export .csv module, custom file name

I have problem with my Access Export to .csv module. Everything works fine in other parts like importing one list, importing second list, doing query and export IF I do not change my output file name, I am lost and don't know why changing output filename cause Access to showing Error:
Runtime Error: 3027:
Cannot update. Database or object is read-only.
Everything works fine If output file stay default.
Module code below:
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 = "Deduplicated list_" & Format(Date, "mmddyyy") & ".csv"
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "tmpExport", fd.SelectedItems(1), True
End If
End If
'Cleanup
db.QueryDefs.Delete "tmpExport"
db.Close
Set db = Nothing
Set qd = Nothing
Set fd = Nothing
End Sub
SORRY: Didn't notice that #Andre in comment above provide me a solution. Thank You very much
Okay, I find the solution. The problem was, when You type in custom name IT MUST HAVE .csv extension. I implement function which appends filename with .csv
Function getCSVName(fileName As String) As String
Dim pos As Long
pos = InStrRev(fileName, ".")
If (pos > 0) Then
fileName = Left$(fileName, pos - 1)
End If
getCSVName = fileName & ".CSV"
End Function
And use it in Export module:
DoCmd.TransferText acExportDelim, , "tmpExport", getCSVName(fd.SelectedItems(1)), True
Looks fine and works for me locally, when I enter an easy SQL command in the code above.
I would recommend to check the SQL command which you try to execute.

Trying to link table between Access DBs using VBA. Getting ISAM not found error

I have a split database where both the front end and back end are accdb files. Because one of my tables uses the AppendOnly = Yes property, I cannot use the link table manager or the refreshlink property when I move the backend. The backend moves from time to time because my IT loves to reshuffle servers.
So my solution is to write a function which prompts for the backend location, deletes all the currently linked tables, and then loops through all the backend tables and links them to the frontend. On this last part I receive a run time error 3170 could not find suitable ISAM. I don't know why.
Code is below:
Public Function MoveDB()
'this function will replace the linked table manager. It will open a file select dialog box to allow the user to pick the new location of the DB backend.
'It will then break all the current links and then recreate them. We need to do this vice use the relink function because the cases table uses AutoAppend which stores old path data
' and breaks the relink function which is why linked table manager does not work.
' FileDialog Requires a reference to Microsoft Office 11.0 Object Library.
'variables to get the database path
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim DriveLetter As String
Dim NetworkPath As String
Dim DrivePath As String
Dim SubPath As String
'variables to link the database
Dim db As DAO.Database
Dim BEdb As DAO.Database
Dim oldtdf As DAO.TableDef
Dim tblName As String
Dim newtdf As DAO.TableDef
Dim BEtdf As DAO.TableDef
Set db = CurrentDb()
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Do not Allow user to make multiple selections in dialog box
.AllowMultiSelect = False
'set the default folder that is opened
.InitialFileName = CurrentProject.Path & "\BE"
' Set the title of the dialog box.
.Title = "Please select the Database Backend"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Access Databases", "*.accdb"
' Show the dialog box. If the .Show method returns True, the
' user picked a file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'We need to determine the full network path (including server name) to the DB backend. The reason is that different users may have the share drive mapped with different letters.
'If the backend is mapped using the drive letter of the user moving the DB then other users may not have a valid path. The full network path is universal
'Get the mapped drive letter from the path of the selected DB file
DriveLetter = Left$(Trim(fDialog.SelectedItems(1)), 2)
'Get the path of the selected DB file minus the drive letter
SubPath = Mid$(Trim(fDialog.SelectedItems(1)), 3)
'Get the full network path of the mapped drive letter
DrivePath = GETNETWORKPATH(DriveLetter)
'Combine the drive path and the sub path to get the full path to the selected DB file
NetworkPath = DrivePath & SubPath
'MsgBox (NetworkPath)
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
'Now we need to delete all the linked tables
For Each oldtdf In db.TableDefs
With oldtdf
If oldtdf.Attributes And dbAttachedODBC Or oldtdf.Attributes And dbAttachedTable Then
'this is a linked table
tblName = .Name
DoCmd.DeleteObject acTable, tblName
End If
End With
Next oldtdf
tblName = ""
'Now we link all the tables from the backend to the front end
Set BEdb = OpenDatabase(NetworkPath)
For Each BEtdf In BEdb.TableDefs
tblName = BEtdf.Name
If Left(tblName, 4) <> "~TMP" Then
Set newtdf = db.CreateTableDef(strTable)
newtdf.Connect = "Database = " & NetworkPath
newtdf.SourceTableName = tblName
newtdf.Name = tblName
db.TableDefs.Append newtdf
End If
Next BEtdf
End Function
The error occurs on the
db.TableDefs.Append newtdf
line. I'm looking to either make this code work, or a way around the known bug that prevents refreshing links when using the AppendOnly=Yes property.
Thanks in advance for any help.
I think you are just missing the semicolon on your string and remove extra spaces
newtdf.Connect = ";Database=" & NetworkPath
Alternatively, you can use DoCmd.TransferDatabase method and be sure to leave out the MSys tables as they have no direct application use between split files:
If Left(tblName, 4) <> "~TMP" And Left(tblName, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", NetworkPath, _
acTable, tblName, tblName, False
End If
found this and worked for me
DAODataSet.SQL.Text := 'SELECT * FROM Country IN "" ";DATABASE=C:\SIMPLE.MDB;PWD=MyPassword"';
DAODataSet.Open;