VBA Excel OpenDialogBox then Transfer the information to cell

[Daniza Morla]

Hi Hello, when I incorporate this code as an add-in within Excel, the data doesn't transfer to cells B12, B14, and B16 as expected. However, when I place the code in a module within the workbook itself, it works correctly.

1. Prompt the user to select an Excel file using the file dialog box.
2. Open the selected Excel file.
3. Retrieve the file location, file name, and the name of the first sheet in the Excel file.
4. Place this information in specific cells of a worksheet (Sheet3 using codename).
5. Close the selected workbook and quit Excel.
6. Display a message box informing the user that the process is complete.

Thank you

Sub SelectExcelFile_()
    Dim selectedFile As Variant
    Dim fileLocation As String
    Dim excelApp As Object
    Dim Workbook As Object
    
    ' Open the file dialog box
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select an Excel File"
        
        ' Show only Excel files in the dialog box
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm"
        
        If .Show = -1 Then ' User clicked OK
            ' Get the selected file path
            selectedFile = .SelectedItems(1)
            
            ' Create an instance of Excel and open the selected file
            Set excelApp = CreateObject("Excel.Application")
            Set Workbook = excelApp.Workbooks.Open(selectedFile)
            
            ' Get the file location
            fileLocation = Left(selectedFile, InStrRev(selectedFile, "\") - 1)
            
            ' Place the file location, file name, and sheet name in cells B12, B14, and B16 respectively
            Sheet3.Range("B12").Value = fileLocation
            Sheet3.Range("B14").Value = Workbook.Name
            Sheet3.Range("B16").Value = Workbook.Sheets(1).Name
            
            ' Close the selected workbook and quit Excel
            Workbook.Close
            excelApp.Quit
            
            ' Clean up the objects
            Set Workbook = Nothing
            Set excelApp = Nothing
            MsgBox "Done, Updating File Location.." & vbCrLf & vbCrLf & "Please Open the file:" & vbCrLf & Sheet3.Range("B14").Value, vbInformation, "Successful _path Folder Location."
        End If
    End With
End Sub

 

[Jaafar Tribak]

Sheet3.Range("B12") .. etc will refer to sheets in the addin.

Maybe you should fully qualify the sheets so they refer to the current workbook:

ThisWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

 

[Jaafar Tribak]

Sheet3.Range("B12") .. etc will refer to sheets in the addin.

Maybe you should fully qualify the sheets so they refer to the current workbook:

ThisWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

Oops. stupid mistake!
It should be:

ActiveWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

 

[Daniza Morla]

ActiveWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

I try this one but, Code stop on this line getting run time error 9, subscription out of range

ThisWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

Also tried this one but code run until the last part, but no data was transfer on the cell

 

[Jaafar Tribak]

ActiveWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

I try this one but, Code stop on this line getting run time error 9, subscription out of range

ThisWorkbook.Sheets("Sheet3").Range("B12").Value = fileLocation

Also tried this one but code run until the last part, but no data was transfer on the cell

Make sure you pass the actual sheet name (not the code name) where you want the values to be transferred:

ActiveWorkbook.Sheets("Actual Sheet Name Goes Here").Range("B12").Value = fileLocation

 

[Daniza Morla]

Make sure you pass the actual sheet name (not the code name) where you want the values to be transferred:

ActiveWorkbook.Sheets("Actual Sheet Name Goes Here").Range("B12").Value = fileLocation

Thank you for sharing your knowledge, It's Working..