I am using FileDialog code for importing Excel table(s) into Access 2013-32 bit that works exactly like I want. When I use the code in Access 2016 I get an error in code that says "Can't find project of library". I have checked my references and they appear to be the same.
Here is my code:
Private Sub Command2_Click()
Dim JobName As String
Dim f As FileDialog
Dim tblImport As String
Dim varfile As Variant
Dim MyJobs As DAO.Recordset
JobName = lbl1.value
DoCmd.Close
Set f = Application.FileDialog(msoFileDialogFilePicker)
With f
.Title = "Choose Excel File(s) to Import"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
.AllowMultiSelect = True
If f.Show = True Then
For Each varfile In .SelectedItems
Msgbox "IMPORTING: " & varfile
tblImport = varfile
DoCmd.TransferSpreadsheet acImport, 10, "Parts", tblImport, True
Next varfile
'Add Job Name to Parts Table
TempVars("jobName") = JobName
DoCmd.OpenQuery "Update Job Name"
'Add Job Name to Jobs Table
Set MyJobs = CurrentDb.OpenRecordset("Jobs")
MyJobs.AddNew
MyJobs![JobName] = JobName
MyJobs.Update
Set f = Nothing
Else
Msgbox "You Cancelled."
End If
End With
End Sub
Related
I'm trying to figure out how to get form, control and property data from an Access form that is not in the Access database from where I start the code. I have figured out how to get the data from within the database but I cant figure out how to get the data from a form outside of the database.
I thought that if I were to set the foreign database to the current database, my code would work. However, after executing "For Each frm In appAccess.Forms," the cursor goes to "End Sub."
I tried to work with containers and I was able to return the form name but I wasn't able to figure out how to loop through the controls and properties collections.
Below is the code associated with my first thought. My end objective is to be able to save form data in a different database. Is there a small error with my code or is there a different method I should use to get the data?
Sub GetControlForm()
Dim strPath As String
Dim frm As Form
Dim ctrl As Control
Dim prop As Property
Dim appAccess As New Access.Application
Dim dbs As DAO.Database
strPath = "C:\Users\Tyrone\Desktop\Test14.accdb"
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase (strPath)
'MsgBox appAccess.CurrentDb.Name
For Each frm In appAccess.Forms
MsgBox frm.Name
For Each ctrl In frm.Controls
MsgBox ctrl.Name
MsgBox ctrl.ControlType.TypeName
MsgBox TypeName(ctrl)
For Each prop In ctrl.Properties
If prop.Name = "RowSource" Then
MsgBox "stop it"
End If
If (TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox") And (prop.Name = "RowSource" Or prop.Name = "ControlSource") Then
MsgBox prop.Value
End If
Next prop
Next ctrl
Next frm
End Sub
The reason your For Each has nothing to loop through is that the forms in the remote database are not open. Per the documentation:
"The properties of the Forms collection in Visual Basic refer to forms
that are currently open."
Try this:
Sub GetControlForm()
Dim strPath As String
Dim obj As AccessObject
Dim frm As Form
Dim ctrl As Control
Dim prop As Property
Dim appAccess As New Access.Application
Dim dbs As DAO.Database
strPath = "C:\Users\Tyrone\Desktop\Test14.accdb"
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase (strPath)
'MsgBox appAccess.CurrentDb.Name
For Each obj In appAccess.CurrentProject.AllForms
appAccess.DoCmd.OpenForm obj.Name
Set frm = appAccess.Forms(obj.Name)
MsgBox frm.Name
For Each ctrl In frm.Controls
MsgBox ctrl.Name
'MsgBox ctrl.ControlType.TypeName
MsgBox TypeName(ctrl)
For Each prop In ctrl.Properties
If prop.Name = "RowSource" Then
MsgBox "stop it"
End If
If (TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox") And (prop.Name = "RowSource" Or prop.Name = "ControlSource") Then
MsgBox prop.Value
End If
Next prop
Next ctrl
appAccess.DoCmd.Close acForm, frm.Name
Next obj
Set frm = Nothing
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Sub
I have an Access file which I will be using for quality assurance of data.
I will be inputting data from three Excel files, each into its own Access table.
At present, I have three buttons and corresponding text boxes. I manually enter the file path and name into the text box, click the button and it completes the rest of my macro, importing the data.
I'd like to use the file picker dialog box to populate the textbox with the path.
This code and worked for me:
Private Sub Comando32_Click()
Dim f As Object
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
If f.Show Then
For Each varItem In f.SelectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
MsgBox "Folder: " & strFolder & vbCrLf & _
"File: " & strFile
Me.certidao.Value = varItem
Next
End If
Set f = Nothing
End Sub
Of course, it is possible to call the file Dialog API in VBA!
An example direct from Microsoft VBA documentation:
Private Sub cmdFileDialog_Click()
' Requires reference to Microsoft Office XY.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Clear listbox contents.
Me.FileList.RowSource = ""
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Please select one or more files"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Access Databases", "*.MDB"
.Filters.Add "Access Projects", "*.ADP"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
Me.FileList.AddItem varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Please note you have to include a reference to Microsoft Office 11.0 Library
(in code window, select menu option Tools, Reference and select your library for the correct version of your Office Version)
Thanks for the response.
I did google it first and tried everything I came across. I also came across the very set of code pasted above. I Played around with it for a while and whatever I did returned errors. I decided to try the code in Excel instead of Access and it worked straight away. The only thing I could think was that the code wasn't applicable to access. Following all of that I asked the question here.
Private Sub cmdDialog_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Me.txtFileSelect.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select one or more files"
.Filters.Clear
.Filters.Add "Excel Files", "*.XLSX"
.Filters.Add "All Files", "*.*"
If .Show = True Then
For Each varFile In .SelectedItems
Me.txtFileSelect.AddItem varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
With this code I get:
Compile error;
User-defined type not identified
Try this code, for single file:
MyFileURL = aBrowseForFile("C:\users\")
Public Function aBrowseForFile(aStartFolder As String) As String
' Needs a reference to Microsoft Office Object Library 15.0
On Error GoTo Err_txtBrowseForFile
Dim fDialog As Office.FileDialog
Dim varfile As Variant
Dim strPath As String
Dim strFilter As String, strFileName As String
Dim Main_Dir As String, DefFolder As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.InitialView = msoFileDialogViewThumbnail
.AllowMultiSelect = False
.Title = "Please select one or more files"
.InitialFileName = aStartFolder
.InitialView = msoFileDialogViewThumbnail
.Filters.Clear
.Filters.Add "all files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
aBrowseForFile = .SelectedItems(1)
Else
'MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit_txtBrowseForFile:
Exit Function
Err_txtBrowseForFile:
MsgBox Err.Description, vbCritical, "MyApp"
Resume Exit_txtBrowseForFile
End Function
Put this function in a module, as it is.
Do not put some other code inside, so you can call it in other projects and build your own tools set.
Call it as shown above in your form.
This code runs well and it is tested.
If you want to check this code, in the debug window type
debug.print aBrowseForFile("C:\users\")
and see what happens. If you have other run-time or compile errors, please post another question.
Hope this helps
Thanks for the response.
I solved the problem in the end, I hadn't selected the object database. I found the following code to work:
Private Sub cmdInput_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select a file"
.Filters.Clear
.Filters.Add "Excel Files", "*.XLSX"
.Filters.Add "All Files", "*.*"
If .Show = True Then
For Each varFile In .SelectedItems
DoCmd.TransferSpreadsheet acImport, 10, "InputData", varFile, True, ""
Beep
MsgBox "Import Complete!", vbExclamation, ""
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
How do I get MS Access to relink an external excel workbook via VBA macro?
I can do this using linked table manager but I would like to do this via VBA, so that I could create a button for users to press to locate the new workbook
Select new workbook
Relink external excel workbook
DoCmd.transferSpreadsheet aclink,,"Sales", "C:\Sales.xlsb", true, "Sales!E2:BC200"
I use the following code to reconnect to linked tables.
Public Function FixTableLink()
Dim db As Database
Dim strPath As String
Dim strConnect As String
strPath = CurrentProject.Path
strPath = strPath & "\DatabaseName.extention"
strConnect = ";DATABASE=" & strPath
Set db = CurrentDb
For Each tbl In db.TableDefs
If Nz(DLookup("Type", "MSysObjects", "Name = '" & tbl.name & "'"), 0) = 6 And tbl.Connect <> strConnect Then
tbl.Connect = strConnect
tbl.RefreshLink
End If
Next tbl
End Function
Change strPath to the path of your backend
You can use the following code to open a dialog box to search for the file path
Function SelectFile() As String
On Error GoTo ExitSelectFile
Dim objFileDialog As Object
Set objFileDialog = Application.FileDialog(1)
With objFileDialog
.AllowMultiSelect = False
.Show
Dim varSelectedItem As Variant
For Each varSelectedItem In .SelectedItems
SelectFile = varSelectedItem
Next varSelectedItem
End With
ExitSelectFile:
Set objFileDialog = Nothing
End Function
'File type filters can be added to the filedialog property using the following syntax:
'.Filters.Clear
'.Filters.Add "File Type Description", "*.file extension"
''Start folder can be specified using:
'.initialfilename="folder path"
Then in the first code block you can use
strPath =selectfile
Something like this, perhaps.
Dim InputFile As String
Dim InputPath As String
InputPath = "C:\ExcelPath\"
InputFile = Dir(InputPath & "*.xls")
Do While InputFile <> ""
DoCmd.TransferSpreadsheet acLink, , "Your table name","Path to your workbook file", True, "Sheet1!RangeYouNeed"
InputFile = Dir
Loop
I'm trying to implement a progress bar for access form. When calling method it throws an error saying user-defined type not defind and error marking in Form_ProgressBar
Private Sub exampleCall1() ' example call for using progress bar with a looping process
Dim pbar As Form_ProgressBar
Dim i As Long Dim steps As Long
steps = 100000
' create new instance of Progress Bar
Set pbar = New Form_ProgressBar
With pbar ' #of steps, Mode, Caption
.init steps, PBarMode_Percent, "Hey, I'm working here!"
For i = 1 To steps
' do something in a loop
' update progress
.CurrentProgress = i
Next i
End With
Set pbar = Nothing
End Sub
Below is the method calling progress bar method
Public Sub ImportExcelfile(tblname As String, drpdwn As String)
Dim ExcelApp As New Excel.Application
Dim ExcelBook As New Excel.Workbook
Dim rng As Excel.Range
Dim rngDefine As Excel.Range
Dim objDialog As Object
Set objDialog = Application.FileDialog(3)
Dim strXls As String
On Error Resume Next
'Dialog box to select the excel file
With objDialog
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files macros enabled", "*.xlsm", 1
.Filters.Add "All Files", "*.*", 2
.Filters.Add "Excel Files", "*.xlsx", 3
If .Show = -1 Then
StrFileName = .SelectedItems(1)
ExcelApp.Visible = False
Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)
Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")
If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then
DoCmd.TransferSpreadsheet transfertype:=acImport, _
tablename:=drpdwn, _
FileName:=StrFileName, Hasfieldnames:=True, _
Range:="Sheet1!I:J", SpreadsheetType:=5
DoCmd.TransferSpreadsheet transfertype:=acImport, _
tablename:=tblname, _
FileName:=StrFileName, Hasfieldnames:=True, _
Range:="Sheet1!A:FK", SpreadsheetType:=5
Else
MsgBox "File you trying to import contains one heading 'text1' in the first
row.Please Delete it before importing"
End If
End With
ExcelBook.Close SaveChanges:=False
Set ExcelBook = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing
End sub
Code from where it is taking time to process is when opening the workbook and setting the range and checking for the perticular text1 in the excel sheet. In that i want to display progess bar
Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)
Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")
If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then
If you've renamed the Progress Bar form, you'll need to change the object type.
Dim pbar as Form_YourNameHere
Set pbar = Neew Form_YourNameHere
Since there is no loop in your code, you will need to manually do some math and increment the CurrentProgress property of the pbar yourself. I've modified your code to do this. There aren't many steps, so the progress will "jump" a little bit.
Public Sub ImportExcelfile(tblname As String, drpdwn As String)
Dim ExcelApp As New Excel.Application
Dim ExcelBook As New Excel.Workbook
Dim rng As Excel.Range
Dim rngDefine As Excel.Range
Dim objDialog As Object
Set objDialog = Application.FileDialog(3)
Dim strXls As String
Dim pbar As Form_ProgressBar 'or whatever you named it
On Error Resume Next
'Dialog box to select the excel file
With objDialog
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files macros enabled", "*.xlsm", 1
.Filters.Add "All Files", "*.*", 2
.Filters.Add "Excel Files", "*.xlsx", 3
If .Show = -1 Then
StrFileName = .SelectedItems(1)
ExcelApp.Visible = False
Set pbar = New Form_ProgressBar 'again, whatever you named the form
'There are 5 distinct steps to this code.
pbar.init 5, PBarMode_Percent
Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)
'increment pbar
pbar.CurrentProgress = 1 '20%
Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")
pbar.CurrentProgress = 2 '40%
If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then
DoCmd.TransferSpreadsheet transfertype:=acImport, _
tablename:=drpdwn, _
fileName:=StrFileName, Hasfieldnames:=True, _
Range:="Sheet1!I:J", SpreadsheetType:=5
'increment pbar
pbar.CurrentProgress = 3 '60%
DoCmd.TransferSpreadsheet transfertype:=acImport, _
tablename:=tblname, _
fileName:=StrFileName, Hasfieldnames:=True, _
Range:="Sheet1!A:FK", SpreadsheetType:=5
'increment pbar
pbar.CurrentProgress = 4 '80%
Else
' remove progress bar on "error"
Set pbar = Nothing
MsgBox "File you trying to import contains one heading 'text1' in the first row.Please Delete it before importing"
End If
End With
ExcelBook.Close SaveChanges:=False
Set ExcelBook = Nothing
xcelApp.Quit
Set ExcelApp = Nothing
'all done
pbar.CurrentProgress = 5 '100%
Set pbar = Nothing
End Sub
For anyone stumbling across this. OP is implementing the MS Access ProgressBar form I originally posted here. http://christopherjmcclellan.wordpress.com/2014/03/08/progress-bar-for-ms-access/
I am attempting to import an Excel spreadsheet into Access using some simple VBA code. The issue I have run into is there are 2 worksheets in the Excel file, and I need the 2nd worksheet to be imported. Is it possible to specify the needed worksheet in the VBA code?
Private Sub Command0_Click()
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls", 1
.Filters.Add "All Files", "*.*", 2
If .Show = -1 Then
StrFileName = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "COR Daily", StrFileName, True
Else
Exit Sub
End If
End With
End Sub
Should I set StrFileName to 'StrFileName'&'.Worksheetname' ? Is that the proper naming scheme for that?
something like:
StrFileName = StrFileName & ".WorkSheetName"
Pass the sheet name with the Range parameter of the DoCmd.TransferSpreadsheet Method. See the box titled "Worksheets in the Range Parameter" near the bottom of that page.
This code imports from a sheet named "temp" in a workbook named "temp.xls", and stores the data in a table named "tblFromExcel".
Dim strXls As String
strXls = CurrentProject.Path & Chr(92) & "temp.xls"
DoCmd.TransferSpreadsheet acImport, , "tblFromExcel", _
strXls, True, "temp!"