vba to retrieve dynamic username for file save

[Mr_Ragweed2]

Hello and thanks for reading! I have a spreadsheet that is saved on multiple users desktop. The issue is i don't (and won't) know who the users are. On the sheet there is a command button that will save it to a folder also on their desktop. This folder ("Finished Work") will have the same name for all users. At the end of the day, when they return to the office, they will upload that folder to Teams. As you can see in my code example below we are all on a One Drive. I know the code to retrieve my own pathway to the folder i just can't seem to find a way to retrieve an unknown username to add into the save pathway.
Any help is always appreciated and thank you in advance if you try and help me!

 ChDir "C:\Users\My_Name\OneDrive - My_Company\Desktop" ' need to make this dynamic to any user - our format for "My_Name" is JSmith

 

[Mr_Ragweed2]

Somehow i got it to work using the following: I'm assuming i finally got the concatenation correct as you pointed out

Dim MyName As String
    MyName = Environ$("Username")
   
    ChDir "C:\Users\" & MyName & "\OneDrive - MyCompany Inc\Desktop\New folder" 'from excel forum
   
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\" & MyName & "\OneDrive - MyCompany Inc\Desktop\New folder" & "\" & newfile & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.AutoSaveOn = False
    ActiveWorkbook.Save

I just went straight to the desktop C:\ drive instead of the https: method. For some reason i didnt think that was possible. What i notice though is when i open that folder it shows the files are still syncing - i'm assuming with OneDrive.
Thank you very much for your help in this matter! it is greatly appreciated.
Next step is to send all of the files in "new folder" to a Teams location. I have done that before from a worksheet but never from a whole folder.

Thanks again.

 

[rollis13]

I'm sorry, but never used OneDrive, so I have no idea what your files should look like in this case.
Anyway, thanks for the positive feedback, glad having been of some help.

 

[Mr_Ragweed2]

i promised i would post results. Sorry it took so long. The following goes thru a folder, saves .xlsx files as pdfs and save them to appropriate destinations in sharepoint Teams. The only issue now is that the pdfs do not open in teams but do from the c:drive.
For this thread, the issue was acquiring an unknown user name so the path to sharepoint could be mapped correctly. As far as that part is concerned. the following is a solution.

Private Sub CommandButton1_Click()

Dim sourceFolderPath As String
Dim oldName As String
Dim newName As String
Dim wb2 As Workbook
Dim FSO As Object
Dim SourceFolder As Object
Dim File As Object

Application.ScreenUpdating = False

Dim MyName As String 'this bit here
MyName = Environ$("Username") 'and this bit here fixed the issue.

sourceFolderPath = "C:\Users\" & MyName & "\OneDrive - my companyInc\Desktop\Propane Forms"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sourceFolderPath)

'12-26 12:30am this mostly works. files go to correct folders as pdfs and are deleted from original folder. "ZSync" is left alone.
' problem is that the pdfs wont open in Teams but will open on the C:drive....

On Error Resume Next

For Each File In SourceFolder.Files

oldName = File.Name

newName = Left(oldName, Len(oldName) - 5)

If oldName Like "*ZSync*.xlsm" Then
Exit Sub

ElseIf oldName Like "*SWO*" & ".xlsx" Then
Set wb2 = Workbooks.Open(File)
wb2.SaveAs fileName:= _
"https://abcd.sharepoint.com/teams/m...ystal, Mary, Anna/Propane Service Work Orders" _
& "/" & newName & ".pdf"
wb2.ExportAsFixedFormat Type:=xlTypePDF
ActiveWindow.Close
Kill "C:\Users\" & MyName & "\OneDrive - my company Inc\Desktop\Propane Forms\" & File.Name

ElseIf oldName Like "*TMS*" & ".xlsx" Then
Set wb2 = Workbooks.Open(File)
wb2.SaveAs fileName:= _
"https://abcd.sharepoint.com/teams/my company/Shared%20Documents/General/Crystal,%20Mary,%20Anna/Tank%20Movement%20Sheet/" _
& newName & ".pdf"
wb2.ExportAsFixedFormat Type:=xlTypePDF
ActiveWindow.Close
Kill "C:\Users\" & MyName & "\OneDrive - my company Inc\Desktop\Propane Forms\" & File.Name

End If

Next File

Set SourceFolder = Nothing
Set FSO = Nothing

End Sub