Forum Discussion

Mike_kelly140's avatar
Mike_kelly140
Copper Contributor
Nov 01, 2022

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_kelly140's avatar
    Mike_kelly140
    Copper 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_gp's avatar
    arnel_gp
    Steel Contributor

    Mike_kelly140 

    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

     

Resources