The OneDrive Nightmare Continues: ThisWorkbook.Path and ThisWorkbook.FullName

Option Explicit

Sub CheckParserFile()

Dim sourcePath As String 

Dim DirYear As Variant 

Dim DirMonth As Variant 

Dim ParserName As String 

Dim ParserFile As String 

Dim PromptString As String 

Dim isfile As String 

Dim PathName As String 

Dim GotName As Boolean 

Dim currentYear As Integer 

Dim answer As String 

Dim HomeDebug As Boolean 

Dim User As String 

Dim Marilyn As Integer 

Const YearCell As String = "B7" 

Const MonthCell As String = "B6" 

Const NameCell As String = "B8" 

HomeDebug = False 

' First attempt at creating unique paths to parser file

If HomeDebug = True Then 

    PathName = "C:\Users\retir\OneDrive\Desktop\WTS\Column test\" 

Else 

    User = VBA.Environ$("OneDrive") ' too many different profiles so we can't build this cleanly 

    Marilyn = InStr(VBA.Environ$("OneDrive"), "Marilyn") ' and Marily is a special case 

    If Marilyn = 0 Then 

        PathName = User & "\WTS Shared\Billing By Month\" 

    Else 

        PathName = User & "\Admin - WTS Shared\Billing By Month\" 

    End If 

End If 

' some debug statements 

Range("A30").Value = "User Profile = " & VBA.Environ$("USERPROFILE") 

Range("A31").Value = "OneDrive = " & VBA.Environ$("OneDrive") 

Range("A32").Value = "user = " & Application.UserName 

Range("A33").Value = "M check = " & Marilyn 

Range("A34").Value = "Path = " & PathName 

currentYear = Year(Date) ' Get the current year 

' 

' Get parser file name and then see if we can open it 

'Get Month 

DirMonth = "" 

Sheets(UserSheet).Select 

PromptString = "Please Enter Month " 

DirMonth = Range(MonthCell).Value 

While DirMonth = "" 

    If DirMonth = 0 Or DirMonth = "" Then 

        DirMonth = Application.InputBox(Prompt:=PromptString, Title:="Month") 

    End If 

Wend 

DirMonth = UCase(Left(DirMonth, 1)) & Mid(DirMonth, 2) 

Range(MonthCell).Value = DirMonth 

DirMonth = Trim(DirMonth) 

'Get year 

Nope: 'Get Year

PromptString = "Please Enter Year " 

DirYear = Range(YearCell).Value 

If Range(YearCell).Value = 0 Or Range(YearCell).Value = "" Then 

    DirYear = Application.InputBox(Prompt:=PromptString, Title:="Year") 

    DirYear = Trim(DirYear) 

End If 

If DirYear <> currentYear Then 

    answer = MsgBox("The year you entered is not the current year, is that what you want? ", vbQuestion + vbYesNo, "Current Year Validation") 

    If answer <> vbYes Then ' meaning no 

        DirYear = "" 

        Range(YearCell).Value = "" 

        GoTo Nope 

    End If 

End If 

Range(YearCell).Value = DirYear 

' get Name 

PromptString = "Please Enter the MailParser file name " 

ParserFile = Range(NameCell).Value 

While ParserFile = "" 

    If Range(NameCell).Value = 0 Or Range(NameCell).Value = "" Then 

        ParserFile = Application.InputBox(Prompt:=PromptString, Title:="MailParser File Name") 

        If ParserFile = "" Then ' this means the user wants to exit 

            AllDone = 1 

            GoTo fini 

        End If 

    End If 

Wend 

Range(NameCell).Value = ParserFile 

ParserFile = Trim(ParserFile) 

GotName = True 

Do While GotName 

    ParserFile = PathName & DirMonth & " Billing\" & DirMonth & " " & DirYear & " Billing" & "\" & "Excel Files\" & ParserFile & ".xlsx" 

    sourcePath = ParserFile 

    If Left(sourcePath, 5) = "https" Then 

        PromptString = "Parser File not found, please re-enter" 

        Range("A28").Value = "Found https \*\*" & sourcePath & "\*\*" 

        GoTo BadFile 

    End If 

    isfile = Dir(sourcePath) 

    If isfile <> "" Then 

        Application.DisplayAlerts = False ' eliminate any issues with links that may need to be updated 

        On Error Resume Next 

        Workbooks.Open sourcePath ' Open parser file 

        On Error GoTo 0 

        GotName = False 

    Else 

BadFile:

        MsgBox ParserFile & " \*\*Does not exist\*\*" 

        PromptString = "Parser File Name" 

        ParserFile = Application.InputBox(Prompt:=PromptString, Title:="Parser File Name") 

        If ParserFile = "" Then ' this means the user wants to exit 

            AllDone = 1 

            GoTo fini 

        End If 

    End If 

Loop 

' now calling the mail parser routine to up load the data in the mail parser 

Call CopyMailParser(sourcePath) 

'Windows(sourcePath).Visible = True 

fini:

If AllDone = 1 Then 

    MsgBox "User requested program termination", , "Code Closing Down" 

End If 

End Sub

Kevin, while not elegant, I decided to just use a bunch of if statements based on the username. This is easier, less time consuming and probably less error prone than getting every to replace their profiles. The good thing is that we are a small company, around 10 employees.

Thanks again for all you've done to help me get through this project.

I have a few concerns with your approach.

You are not using my function for translating a workbook's path from a URL to a local path. This actually makes sense as you are only looking for workbooks from the shared space, not running code in a workbook opened from a shared space.

You are building the final path by showing multiple user input dialogs. Why not show an open file dialog and have the user navigate to the desired workbook in one simple step?

If you do want to query the user for a month and a year, why not peruse the shared space and determine the months and years available and show them as a drop down on a single dialog? You can even show the list of files inside the respective month/year folder and have the user select the file to open from there.

All that said, you are saying that the root path varies by user and is difficult to determine in a generic manner. I can't make any recommendations regarding this without more information about how they differ.

You are getting the environment variable "OneDrive" which will work if only one OneDrive account is in effect. I have three and this environment variable only holds the path for one of them. Which is why I built the function to do the translation using a more complete accounting of the shared space in the registry.

Kevin

I really appreciate your help and support as I struggle to get my first VBA program to work.

The two limitations that I face in developing this application are that in the past, with my limited programming experience, all of which was as UNIX shell programmer managing systems without user interaction (a very different world than Windows and OneDrive).

The other limitation is that whoever setup the environments for this company didn’t have a standard user profile. My guess is this was because of how the company grew and when the IT support people were brought into the picture.

What you are saying makes lots of sense going forward in that it would require less code maintenance. What leads me to think that there are 2 options:

1. Create code that mimics the File Explorer and allows the user to dropdown and select the required file
2. Find the URL of the file they are looking for given the current structure (e.g. having the year, month and file name provide before the code is executed)

I like both ideas but for this I think that #1 is probably a better solution since they are already searching the file that is to be loaded. That said I have no idea how to write that code. Is there some place you can point me for examples?

As for each user having a different profile here is what I’m referring to:

• C:\Users\Admin.WTSLT07\OneDrive - Waste Tech Services\WTS Shared\
• C:\Users\MB\Waste Tech Services\Admin - WTS Shared
• C:\Users\KK\OneDrive - Waste Tech Services\ WTS Shared\

These are the only 3 that I’ve encountered so far but I suspect that it is indicative of the rest of the logins.

"My guess is this was because of how the company grew and when the IT support people were brought into the picture."

This is the most common description of a company's screwed up infrastructure.

"As for each user having a different profile..."

That's OneDrive and SharePoint for you. It's one crazy screwed up system. The URL being returned for ThisWorkbook.FullName is one thing, and what you are observing for the base paths for each user is another. Trying to sort all this out and do what we are trying to do is a royal pain. Thank you Microsoft!

Here is code to show a file open dialog...

To ask for an existing file name use the GetOpenFilename function. The function accepts five optional parameters which are described below.

FileFilter - A string specifying file filtering criteria. The string can contain any number of criteria seperated with commas where each criterion consists of two elements: a readable description and an MS-DOS file filter description. The readable description does not have any syntax requirements. The second element is an MS-DOS file filter specification. Some examples:

"Text Files (\*.txt), \*.txt" 

"All Files (\*.\*),\*.\*" 

"Microsoft Excel Workbook (\*.xls), \*.xls" 

If omitted, this argument defaults to "All Files (*.*),*.*".

FilterIndex - Specifies the index number of the default file filtering criteria, from 1 to the number of filters specified in FileFilter. If this argument is omitted or greater than the number of filters present, the first file filter is used.

Title - Specifies the title of the dialog box. If this argument is omitted, the default title is used which is "Open".

ButtonText - The text in the command button. Valid only on the Macintosh.

MultiSelect - True to allow multiple file names to be selected. False to allow only one file name to be selected. The default value is False.

The GetOpenFilename returns a full path to the selected file or False is Cancel was clicked. If assigned to a variant the variant is changed to a Boolean data type and set to False. The easiest way to use the GetOpenFilename function is to assign it to a variant and then test for the variable type as illustrated with the sample code below.

Dim FilePath As Variant

FilePath = Application.GetOpenFilename("Microsoft Excel Workbook (*.xls), *.xls")

If VarType(FilePath) = vbBoolean Then

  MsgBox "Dialog cancelled." 

Else

  ' Do something with the file path 

End If

Below is example code to query for a file name starting in a specific directory.

Dim FilePath As Variant

ChDir CreateObject("Wscript.Shell").SpecialFolders("Desktop")

FilePath = Application.GetOpenFilename("Text File (*.txt), *.txt")

If VarType(FilePath) = vbBoolean Then Exit Sub

Kevin