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

Question

我有一个在本地 PC 上打开的 OneDrive Excel 工作簿。 我有一个宏，它可以生成发票并将其以 pdf 格式保存到我的 OneDrive 上的子目录中。 到目前为止没有问题。 但是，当我使用另一个宏附加之前保存的文件时，宏找不到该文件。 我已经建立了子目录存在使用

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

给我一个找不到文件的错误

这是我正在使用的完整的“SendEmail”子。

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

Answer 1

可能的解决方案是：

1. 启动 OneDrive
2. 使用宏为您的 Excel 工作簿创建一个单独的文件夹
3. 右键单击该文件夹和 select “始终保留在此设备上”

这样您的 vba 代码应该引用本地文件，而不是引用它的云位置