У меня есть книга OneDrive Excel, которую я открыл на локальном компьютере P C. У меня есть макрос, который создает счет-фактуру и сохраняет его в формате 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