VBA Excel OpenDialogBox then Transfer the information to cell

[Ilounah]

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 🙏

expandcollapse popup

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