问在尝试使用VBA访问OneDrive文件夹中的文件时，我遇到了OneDrive的问题。

EN

Function URLExists(url As String) As Boolean
    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo EndNow
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set Request = Nothing
    If rc = "OK" Then URLExists = True

    Exit Function
EndNow:
End Function

Function FileExists(filename)
    On Error Resume Next
    FileExists = (Dir(filename) <> "")
End Function

Sub SendMail()
    Const cdoSendUsingPickup = 1                        '*** Send message using the local SMTP service pickup directory.
    Const cdoSendUsingPort = 2                          '*** Send the message using the network (SMTP over the network).
    Const cdoAnonymous = 0                              '*** Do not authenticate
    Const cdoBasic = 1                                  '*** Basic (clear-text) authentication
    Const cdoNTLM = 2                                   '*** NTLM
    mySubject = Trim(Cells(16, 3))
    myTestEmail = Trim(Cells(12, 12))
    myAttachment1 = myFileName & ".pdf"
    myAttachment1 = "Testing.xlsx"
    '*******************************************
    '*** This bit checks the pdf file exists ***
    '*******************************************
    If Not FileExists(myProgramPath & myAttachment1) Then '--- This gives TRUE i.e. file does not exist
        MsgBox "Attachment file does not exist"
        Exit Sub
    End If

    '--- This is the format of the url "https://d.docs.live.net/xxxxx/xxxxxxxxxxx/xxxxx/"
    '--- I've tried changing the direction of the "/" with myProgramPath = Replace(myProgramPath, "\", "/")
    '--- but makes no difference which way they face

    If Not URLExists(myProgramPath) Then '--- This is FALSE i.e. folder does exist
        MsgBox "Folder does not exist"
        Exit Sub
    End If
    Set objMessage = CreateObject("CDO.Message")
    Set objConf = CreateObject("CDO.Configuration")
    objMessage.AddAttachment myProgramPath & myAttachment1 '--- This is where the error occurs
    objMessage.CreateMHTMLBody "file://" & myProgramPath & "StatementBody.html" '*** This is the html file that creates the body of the email
    myTo = Trim(Cells(22, 5))
    myFrom = Chr(34) & "xxxxxxxxxxxxxxxx" & Chr(34) & "<" & "xxxxxxxxxxxxxx@xxxxxxxxxxxx" & ">"
    myFrom = "xxxxxxxxxxxxxxxxxxxx <" & "xxxxxxxxxxxxxxx@xxxxxxxxxxxx" & ">"
    myBcc = Trim(Sheets("Lookups & Validation").Cells(13, 9))
    objMessage.Subject = mySubject
    objMessage.From = myFrom
    objMessage.To = myTo
    objMessage.bcc = myBcc
    '*** This section provides the configuration information for the remote SMTP server.
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.ionos.co.uk"                     '*** Name or IP of Remote SMTP Server
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic                         '*** Type of authentication, NONE, Basic (Base64 encoded), NTLM
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxx@xxxxxxxxxxxxxxx"              '*** Your UserID on the SMTP server
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Dulceetdec0rumest%"                 '*** Your password on the SMTP server
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587                                      '*** Server port (typically 25)
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False                                       '*** Use SSL for the connection (False or True)
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60                               '*** Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objMessage.Configuration.Fields.Update
    '*** End remote SMTP server configuration section
    objMessage.Send
    Set objMessage = Nothing
    Set objConf = Nothing
End Sub