Jump to content

VBA Excel OpenDialogBox then Transfer the information to cell


Recommended Posts

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.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
            ' 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


Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

  • Recently Browsing   0 members

    • No registered users viewing this page.
  • Create New...