VBA OneDrive issues

Hello all,

My company just migrated over to One Drive from a corporate shared drive, our inventory spreadsheet would use ThisWorkbook.path to save a copy each time someone would email it, now with One Drive using an HTTP protocol I get the run time error. Would someone please help me with what I need to change up or insert in my code?
Thanks ahead of time.

Administrator's note: Please take the time to review our rules. There aren't many, and they are all important. Our guidelines recommend code tags. I have added them for you this time because you are a new member. --6StringJazzer

Sub Send_Outlook_Albany()
'>>>>>>>>>>>>>>>

'setup for Outlook 3/5/16

'<<<<<<<<<<<<<<
Dim wb, Wbsf As Workbook
Dim ans, FileVer As Integer
Dim wbsf1, suggname, salesdate, salesdate1, saveformat As String
Dim ExisFile, VerStr As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Terminal As String
Dim I As Long
                    
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
                    
 
Terminal = "Tampa"

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
saveformat = Application.DefaultSaveFormat
 
                     ans = MsgBox("This will Email a copy of this report via OUTLOOK" & vbCrLf & vbCrLf & _
                    "OK?", vbYesNoCancel + vbQuestion)
                    If ans = 2 Then Exit Sub
                    If ans = 7 Then MsgBox "Try again": Exit Sub
                    
                    
FileExtStr = ".xlsx": FileFormatNum = 51

FileVer = 1
salesdate = Sheets("Tank Report").Range("h4").Text
salesdate1 = Application.Text(salesdate, "mm-dd-yyyy")
VerStr = " (" & FileVer & ")"
suggname = Terminal & " Inventory Report " & salesdate1 & VerStr & FileExtStr
        
'>>>>>>>>>>
'Copies File over to new workbook
'use for Emailing via Notes
Set wb = ActiveWorkbook
Set Wbsf = Workbooks.Add
Set Wbsf = ActiveWorkbook
wbsf1 = suggname


' Checks to see if file exists ...
'Add Digit to version number
Do While Dir(ThisWorkbook.Path & "" & wbsf1) <> ""

ExisFile = Dir(ThisWorkbook.Path & "" & wbsf1)
FileVer = Mid(ExisFile, InStr(ExisFile, "(") + 1, 1)
FileVer = FileVer + 1
VerStr = " (" & FileVer & ")"
suggname = Terminal & " Inventory Report " & salesdate1 & VerStr & FileExtStr
wbsf1 = suggname
'MsgBox FileVer
'MsgBox "OOPS File Exists", vbOKCancel + vbQuestion

Loop

On Error GoTo Errorhandler1

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & wbsf1, FileFormat:=FileFormatNum

wbsf1 = Wbsf.Name
                    If Val(Application.Version) > 14 Then
                            'You use Excel 2013 or higher
                        With Wbsf
                        Sheets.Add After:=ActiveSheet
                        Sheets.Add After:=ActiveSheet
                        End With
                    Else
                            'You use Excel 2010 or lower
                    End If
With wb
    .Activate
    .Sheets("Tank Report").Activate
    Range("a1:r57").Select
   .Sheets(Array("Tank Report", "Inventory", "Status")).Select
    Selection.Copy
End With

With Wbsf.Sheets("Sheet1").Range("a1")
    .PasteSpecial xlPasteAllUsingSourceTheme
    '.PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteValues
End With
 
 
 'Get a Global logo. Check for name
    wb.Sheets("vessel report").Activate
    ActiveSheet.Shapes("Picture 199").Select
    Selection.Copy
    
    
  
    Wbsf.Sheets("sheet3").Activate
    ActiveWindow.DisplayGridlines = False
    Wbsf.Sheets("sheet2").Activate
    ActiveWindow.DisplayGridlines = False
    Wbsf.Sheets("sheet1").Activate
    ActiveWindow.DisplayGridlines = False
   
    'Paste Global Logo
    Wbsf.Sheets("Sheet1").Range("a1").Select
    ActiveSheet.Paste
    Wbsf.Sheets("sheet3").Activate
    Wbsf.Sheets("Sheet3").Range("a1").Select
    ActiveSheet.Paste
    Wbsf.Sheets("sheet2").Activate
    Wbsf.Sheets("Sheet2").Range("a1").Select
    ActiveSheet.Paste


'Resets Original Workbook
With wb
    .Sheets("Status").Activate
    .Sheets("Status").Select
    Range("a1").Select
    .Sheets("Tank Report").Activate
    .Sheets("Tank Report").Select
    Range("c10").Select
    .Sheets("Rate Report").Activate
    .Sheets("Rate Report").Select
    Range("D3").Select
    .Sheets("Vessel Report").Activate
    .Sheets("Vessel Report").Select
    Range("C5").Select
    .Sheets("Inventory").Select
End With
Application.CutCopyMode = False


' sets up the send file
With Wbsf
    .Sheets("sheet1").Name = "Tank Report"
    .Sheets("sheet2").Name = "Inventory"
    .Sheets("sheet3").Name = "Status"

    
   ' activate and set print area
    .Sheets("Tank Report").Activate
    .Sheets("Tank Report").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:R57"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Tank Report").Range("a1").Select
    
    'activate and set print area
    .Sheets("Inventory").Activate
    .Sheets("Inventory").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:p35"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Inventory").Range("a1").Select
    
    'activate and set print area
    .Sheets("Status").Activate
    .Sheets("Status").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:i42"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Status").Range("a1").Select
  
          
    .Sheets("Inventory").Activate
    .Sheets("Inventory").Range("a1").Select

End With
    
ActiveWorkbook.Save


'<<<<<<<<<<<MAIL it


Application.CutCopyMode = False

Try this...

Dim OneDrivePath As String
OneDrivePath = ThisWorkbook.Path & "\"
If OneDrivePath Like "https:*" Then
    OneDrivePath = Replace(Environ("OneDrive") & "\" & Split(OneDrivePath, "/", 5)(4), "/", "\")
End If

For some reason, I keep getting a bad file name or number on this statement.

Terminal = "Fayetteville"
OneDrivePath = ThisWorkbook.Path & ""
If OneDrivePath Like "https:*" Then
    OneDrivePath = Replace(Environ("OneDrive") & "" & Split(OneDrivePath, "/", 5)(4), "/", "")
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
saveformat = Application.DefaultSaveFormat
 
                     ans = MsgBox("This will Email a copy of this report via OUTLOOK" & vbCrLf & vbCrLf & _
                    "OK?", vbYesNoCancel + vbQuestion)
                    If ans = 2 Then Exit Sub
                    If ans = 7 Then MsgBox "Try again": Exit Sub
                    
                    
FileExtStr = ".xlsx": FileFormatNum = 51

FileVer = 1
salesdate = Sheets("Tank Report").Range("h4").Text
salesdate1 = Application.Text(salesdate, "mm-dd-yyyy")
VerStr = " (" & FileVer & ")"
suggname = Terminal & " Inventory Report " & salesdate1 & VerStr & FileExtStr
        
'>>>>>>>>>>
'Copies File over to new workbook
'use for Emailing via Notes
Set wb = ActiveWorkbook
Set Wbsf = Workbooks.Add
Set Wbsf = ActiveWorkbook
wbsf1 = suggname


' Checks to see if file exists ...
'Add Digit to version number
Do While Dir(ThisWorkbook.Path & "" & wbsf1) <> ""

Administrative Note:

Welcome to the forum.

Is your forum profile showing the Excel PRODUCT that you need this to work for?

Members will tailor the solutions they offer to the Office PRODUCT (Excel, NOT Windows) that you have. Please check that your forum profile is up-to-date in this respect. If you aren't sure, in Excel go to File | Account and report what it says below the MS logo at the top of that page. If your product is for Mac, please also state this.

The three most recent Excel products are Excel 2019, Excel 2021 and MS365 - if you are using MS365, please give this name along with the version number in your profile (e.g. MS365 Version 2306). This is in the About Excel section further down the Account page.

Thanks.

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however we recommend that you include code tags around your code.

Please take a moment to add the tags. Posting code between [code] [/code] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Guideline #2 about code tags. I have added them for you this time. You have already been warned about this - please don't forget again!

Rest of your code is missing and not possible to ascertain reasoning...You cannot just plug that snippet in and leave all else as is...Upload a sample file and explain in step by step detail what it is you are trying to achieve...see top yellow banner...

Is there a URL in the code? If so, replace it with xxxx.

I've attached the entire code that I have, when I run it and it hits (Do While Dir(ThisWorkbook.Path & "" & wbsf1) <> "") I get the error, I only assume this is because of ThisWorkbook.Path gives back a URL for OneDrive. I've tried a bunch of different options all giving me the same results. I can't hardcode a path because it will be used by a host of users all using different OneDirve or SharePoint per facility.

Option Explicit
Sub Send_Outlook_Albany()
'>>>>>>>>>>>>>>>

'setup for Outlook 3/5/16

'<<<<<<<<<<<<<<
Dim wb, Wbsf As Workbook
Dim ans, FileVer As Integer
Dim wbsf1, suggname, salesdate, salesdate1, saveformat As String
Dim ExisFile, VerStr As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Terminal As String
Dim I As Long
                    
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
                    
 
Terminal = "Tampa"

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
saveformat = Application.DefaultSaveFormat
 
                     ans = MsgBox("This will Email a copy of this report via OUTLOOK" & vbCrLf & vbCrLf & _
                    "OK?", vbYesNoCancel + vbQuestion)
                    If ans = 2 Then Exit Sub
                    If ans = 7 Then MsgBox "Try again": Exit Sub
                    
                    
FileExtStr = ".xlsx": FileFormatNum = 51

FileVer = 1
salesdate = Sheets("Tank Report").Range("h4").Text
salesdate1 = Application.Text(salesdate, "mm-dd-yyyy")
VerStr = " (" & FileVer & ")"
suggname = Terminal & " Inventory Report " & salesdate1 & VerStr & FileExtStr
        
'>>>>>>>>>>
'Copies File over to new workbook
'use for Emailing via Notes
Set wb = ActiveWorkbook
Set Wbsf = Workbooks.Add
Set Wbsf = ActiveWorkbook
wbsf1 = suggname


' Checks to see if file exists ...
'Add Digit to version number
Do While Dir(ThisWorkbook.Path & "\" & wbsf1) <> ""

ExisFile = Dir(ThisWorkbook.Path & "\" & wbsf1)
FileVer = Mid(ExisFile, InStr(ExisFile, "(") + 1, 1)
FileVer = FileVer + 1
VerStr = " (" & FileVer & ")"
suggname = Terminal & " Inventory Report " & salesdate1 & VerStr & FileExtStr
wbsf1 = suggname
'MsgBox FileVer
'MsgBox "OOPS File Exists", vbOKCancel + vbQuestion

Loop

On Error GoTo Errorhandler1

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & wbsf1, FileFormat:=FileFormatNum

wbsf1 = Wbsf.Name
                    If Val(Application.Version) > 14 Then
                            'You use Excel 2013 or higher
                        With Wbsf
                        Sheets.Add After:=ActiveSheet
                        Sheets.Add After:=ActiveSheet
                        End With
                    Else
                            'You use Excel 2010 or lower
                    End If
With wb
    .Activate
    .Sheets("Tank Report").Activate
    Range("a1:r57").Select
   .Sheets(Array("Tank Report", "Inventory", "Status")).Select
    Selection.Copy
End With

With Wbsf.Sheets("Sheet1").Range("a1")
    .PasteSpecial xlPasteAllUsingSourceTheme
    '.PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteValues
End With
 
 
 'Get a Global logo. Check for name
    wb.Sheets("vessel report").Activate
    ActiveSheet.Shapes("Picture 199").Select
    Selection.Copy
    
    
  
    Wbsf.Sheets("sheet3").Activate
    ActiveWindow.DisplayGridlines = False
    Wbsf.Sheets("sheet2").Activate
    ActiveWindow.DisplayGridlines = False
    Wbsf.Sheets("sheet1").Activate
    ActiveWindow.DisplayGridlines = False
   
    'Paste Global Logo
    Wbsf.Sheets("Sheet1").Range("a1").Select
    ActiveSheet.Paste
    Wbsf.Sheets("sheet3").Activate
    Wbsf.Sheets("Sheet3").Range("a1").Select
    ActiveSheet.Paste
    Wbsf.Sheets("sheet2").Activate
    Wbsf.Sheets("Sheet2").Range("a1").Select
    ActiveSheet.Paste


'Resets Original Workbook
With wb
    .Sheets("Status").Activate
    .Sheets("Status").Select
    Range("a1").Select
    .Sheets("Tank Report").Activate
    .Sheets("Tank Report").Select
    Range("c10").Select
    .Sheets("Rate Report").Activate
    .Sheets("Rate Report").Select
    Range("D3").Select
    .Sheets("Vessel Report").Activate
    .Sheets("Vessel Report").Select
    Range("C5").Select
    .Sheets("Inventory").Select
End With
Application.CutCopyMode = False


' sets up the send file
With Wbsf
    .Sheets("sheet1").Name = "Tank Report"
    .Sheets("sheet2").Name = "Inventory"
    .Sheets("sheet3").Name = "Status"

    
   ' activate and set print area
    .Sheets("Tank Report").Activate
    .Sheets("Tank Report").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:R57"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Tank Report").Range("a1").Select
    
    'activate and set print area
    .Sheets("Inventory").Activate
    .Sheets("Inventory").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:p35"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Inventory").Range("a1").Select
    
    'activate and set print area
    .Sheets("Status").Activate
    .Sheets("Status").Select
       With ActiveSheet.PageSetup
        .PrintArea = "A1:i42"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
       End With
       .Sheets("Status").Range("a1").Select
  
          
    .Sheets("Inventory").Activate
    .Sheets("Inventory").Range("a1").Select

End With
    
ActiveWorkbook.Save


'<<<<<<<<<<<MAIL it


Application.CutCopyMode = False

 On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = wbsf1
        .Body = " Attached is the file - " & wbsf1
        .Attachments.Add Wbsf.FullName
        .Display '.send
    End With
    On Error GoTo 0


With Wbsf
          .Close SaveChanges:=False
End With

                 
                   Set OutApp = Nothing
                   Set OutMail = Nothing
                   
                   
With wb.Sheets("Inventory")
    .Activate
    .Select
    .Range("a1").Select
End With
 
'Set DefaultSaveFormat back to the users setting
Application.DefaultSaveFormat = saveformat

With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
End With

Exit Sub
Errorhandler1:

With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
End With

End Sub

Tampa inventory 1.7.24 sales date. Folio 5.xlsm

I gave you the answer in Post 2...

Dim OneDrivePath As String ' Add a variable declaration
OneDrivePath = ThisWorkbook.Path & "\"
If OneDrivePath Like "https:*" Then
    OneDrivePath = Replace(Environ("OneDrive") & "\" & Split(OneDrivePath, "/", 5)(4), "/", "\")
End If

Then you need to implement it correctly...Replacing All your code snippets of

ThisWorkbook.Path

with

OneDrivePath

Cannot access your code as your file vb project is password protected...don't feel like running code to crack now...
Try closng the wbsf workbook first before attaching it...

Sorry about that, I thought maybe it would be a quick fix.

it should be...did you try closing the file before ... in other words moving the

With Wbsf
    .Close SaveChanges:=False
End With

to above the

With OutMail

Or just upload a file which is not password protected...

To be honest with you...That code is a mess...and not easy to follow...
What do you get when you run this...
Place it before your outlook code...

Debug.Print Wbsf.FullName

and then

Debug.Print Replace(Wbsf.FullName,"%20"," ")

I don't have your setup so I cannot recreate your issue...and like I said, your code is a mess...
If I were you, I would redo it...Expalin in detail what is is you are wanting to achieve...step by step and just perhaps someone will be able to simplify it without errors...