Forum Discussion
Unbound Text box Value to strPathFile variant in Access using Visual basic.
I am in need of some help. I am trying to import an excel book, with different sheets into Access. The problem I am having is copying the link from the Textfilename to module1 so that it is somewhat automated. For the life of me, I can't figure it out. I think it is not really written to the text box is the problem, but not sure. Any help would be appreciated!
Thanks
Mike
Public Sub Import_File(Filename As String, tablename As String)
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim Item As Variant
Dim strPassword As String
Dim strPathFile As Variant
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Filename.xls with the actual path and filename
strPathFile = File
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString )
strPassword = vbNullString
blnReadOnly = True ' open EXCEL file in read-only mode
' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
End Sub
Public Sub bntBrowse_Click()
Dim diag As Office.FileDialog
Dim Item As Variant
Dim File As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select a excel spreadsheet"
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheets", "*.xls,*.xlsx"
If diag.Show Then
For Each Item In diag.SelectedItems
Me.txtFileName = Item
Next
End If
End Sub
Public Sub bntImportSpreadsheet_Click()
Dim FSO As New FileSystemObject
Dim File As Variant
If Nz(Me.txtFileName, "") = "" Then
MsgBox "Please select a file!"
Exit Sub
End If
If FSO.FileExists(Nz(Me.txtFileName, "")) Then
Module1.Import_File Me.txtFileName, FSO.GetFileName(Me.txtFileName)
Else
MsgBox "File Not found"
End If
2 Replies
- Mike_kelly140Copper Contributor
Sorry for the late reply.
I was able to correct it by adding a text box and hiding it. Then I was able to pulled in the data I needed into the module code.
Private Sub txtFileName_AfterUpdate()
Dim diag As Office.FileDialog
Dim Item As Variant
Dim File As Variant
If diag.Show Then
File = Item
End If
End Sub
Thanks
Mike - arnel_gpSteel Contributor
you try this one, copy (replace your code on the Module):
Public Sub Import_File(ByVal Filename As String, ByVal tablename As String) Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim Item As Variant Dim strPassword As String Dim strPathFile As Variant ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = True ' Replace C:\Filename.xls with the actual path and filename strPathFile = Filename ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString ) strPassword = vbNullString blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing End If ' Import the data from each worksheet into a separate table For lngCount = colWorksheets.Count To 1 Step -1 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ ' "tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _ ' colWorksheets(lngCount) & "$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ tablename & "_" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _ colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub
on your form:
Public Sub bntBrowse_Click() Dim diag As Office.FileDialog Dim Item As Variant Dim File As Variant Set diag = Application.FileDialog(msoFileDialogFilePicker) diag.AllowMultiSelect = False diag.Title = "Please select a excel spreadsheet" diag.Filters.Clear diag.Filters.Add "Excel Spreadsheets", "*.xls,*.xlsx" If diag.Show Then For Each Item In diag.SelectedItems Me.txtFileName = Item Next End If End Sub Public Sub bntImportSpreadsheet_Click() Dim FSO As New FileSystemObject Dim File As Variant Dim ext As String If Nz(Me.txtFileName, "") = "" Then MsgBox "Please select a file!" Exit Sub End If If FSO.FileExists(Nz(Me.txtFileName, "")) Then File = FSO.GetFileName(Me.txtFileName) ext = FSO.GetExtensionName(Me.txtFileName) If Len(ext) <> 0 Then File = Replace$(File, "." & ext, "") End If Module1.Import_File Me.txtFileName, File Else MsgBox "File Not found" End If End Sub