VBA Default Directory for GetOpenFilename accessued from other Office program

Context:  My goal is to update links between PPT and Excel, and have the user select the new file to link to.  We have monthly files with just the numbers changing (eg, table sizes are all fixed).

I'm trying to set the default directory that Excel shows when using the GetOpenFilename.  The trick is my code is in PowerPoint, and I am opening the Excel file with the CreateObject("Excel.Application").  The code I tried is here, but when it opens the GetOpenFilename, it goes only to MyDocuments:

    Set exl = CreateObject("Excel.Application")

    ChDrive Left(ActivePresentation.Path, 2)
    strNewDrive = Left(ActivePresentation.Path, 2)
    ChDir ActivePresentation.Path
    strNewDir = ActivePresentation.Path

    ExcelFileNew = exl.Application.GetOpenFilename(, , "Select Excel File")





'  The rest of the code is a bit clumsy, but attached.
LVL 2
ajakewayAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jamie GarrochSenior Technical Consultant at BrightCarbonCommented:
I use GetSetting and SaveSetting to store MRU paths for this purpose. That way you can access the paths from any Office app hosting VBA. A default path can be set when your app runs for the first time assuming you don't set the registry setting with an installer.

Example:

Public Const REG_PROD = "My Product Name"
Public Const REG_PREFS = "Preferences"
Public Const REG_PATH = "Excel File Path"

Sub SaveAndGetSetting()
' Save a setting in the VBA area of the Windows Registry using
' AppName, Section, Key, Setting
SaveSetting REG_PROD, REG_PREFS, REG_PATH, Environ("APPDATA") & "\MyApp"
' Get the setting and optionally use a default value if the setting doesn't exist
Debug.Print GetSetting (REG_PROD, REG_PREFS, REG_PATH, Environ("APPDATA") & "\MyApp")
End Sub

Open in new window


You can then use that path to pre-define the path in your code or within a user folder/file selection dialog box.

You can also see/modify the settings using regedit.exe here:

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\My App Name
JSRWilsonCommented:
If you just need to select an Excel File maybe this would work in PPT (The code does not seem to be attached BTW)

Dim exl As Object
Dim fd As FileDialog
Dim strFilename As String
Set exl = CreateObject("Excel.Application")
Set fd = PowerPoint.Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls,*.xlsx"
.InitialFileName = "C:\Users\Optiplex\Desktop\"
If .Show = True Then
strFilename = .SelectedItems(1)
End If
End With
MsgBox "Path= " & strFilename
MsgBox "Filename= " & Right(strFilename, Len(strFilename) - InStrRev(strFilename, "\"))

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ajakewayAuthor Commented:
JSRWilson - thanks!  Perfect.  Works exactly as I need it to!!  To be dynamic as I required (and as our files are saved), I changed this line:
.InitialFileName = "C:\Users\Optiplex\Desktop\"          'to this:
.InitialFileName = ActivePresentation.Path
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

ajakewayAuthor Commented:
Jamie - I'm not seeing this would work within a simple *.pptm file, but the code looks like it was the right direction too.  Thanks for the response.
ajakewayAuthor Commented:
Thought clearly about my end goal and not just the process I *thought* I wanted to follow.  Quick and elegent solution.
ajakewayAuthor Commented:
Full code (for posterity)

'PPT Link Updater

'originally from:   http://www.ozgrid.com/forum/showthread.php?t=147605

Sub M1()
    Dim sld As Slide
    Dim sh As Shape
    Dim ExcelFileNew
    Dim ExcelFileOld As String
    Dim intLenFileOld As Integer
    Dim intLenFileNew As Integer
    Dim exl As Object
    Dim strNewDrive, strNewDir As String
    Dim fd As FileDialog
    Set exl = CreateObject("Excel.Application")
    Set fd = PowerPoint.Application.FileDialog(msoFileDialogOpen)


    With fd
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls,*xlsx,*xlsm"
        .InitialFileName = ActivePresentation.Path
        If .Show = True Then strFilename = .SelectedItems(1)
    End With

'MsgBox "Filename= " & Right(strFilename, Len(strFilename) - InStrRev(strFilename, "\"))

    Call stripPath(ExcelFileNew, filenameNew)

    For Each sld In ActivePresentation.Slides
        sld.Select
        For Each sh In sld.Shapes
            If sh.Type = msoLinkedOLEObject Then
                With sh.LinkFormat
                    LinkOld = .SourceFullName
                    Call stripReference(LinkOld, fullpathOld)
                    Call stripPath(fullpathOld, filenameOld)
                   
                    LinkNew = ExcelFileNew & Mid(LinkOld, Len(fullpathOld) + 1, 99)
                   
'  Only replace it if the file name is similar...
'  so "extras" like Cash balances are not replaced by the Trust Fees file
                    If Left(filenameOld, 25) = Left(filenameNew, 25) Then
                        .SourceFullName = LinkNew
                    End If
                End With
            End If
        Next sh
    Next sld

ExitMySub:
End Sub
 '
Sub stripPath(fullPath, filename)
     
     'This will take c:\folder\workbook.xlsx* and provide workbook.xlsx*
    Dim filenamePosition As Long
     
    filenamePosition = InStrRev(fullPath, "\")
    filename = Mid(fullPath, filenamePosition + 1, Len(fullPath) - filenamePosition)
     
End Sub
 '
Sub stripReference(fullReference, filename)
     
     'This will take *workbook.xls!Graphs![workbook.xls]Graphs Chart 1 and provide *workbook.xls
    Dim referencePosition As Long
     
    referencePosition = InStr(1, fullReference, "!")
    filename = Left(fullReference, referencePosition - 1)
     
End Sub
 '
Sub showStrings(ExcelFileNew, filenameNew, LinkOld, fullpathOld, filenameOld, LinkNew)
     
     'This is just a debugging function to display the variables
    MsgBox ("ExcelFileNew: " & ExcelFileNew & vbNewLine _
    & "filenameNew: " & filenameNew & vbNewLine _
    & "LinkOld: " & LinkOld & vbNewLine _
    & "fullpathOld: " & fullpathOld & vbNewLine _
    & "filenameOld: " & filenameOld & vbNewLine _
    & "LinkNew: " & LinkNew)
     
End Sub
JSRWilsonCommented:
Yep I should have pointed out that the "default" was to my own desktop!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.