0

试图在 Outlook 中拼凑一些 vba 代码。Set ftoFldr 抛出文件空错误。我知道我的路径是正确的（出于隐私目的在此处更改）。我在 sub 中使用了 fto 而不是 fso，因为我一开始就已经在函数中使用了 fso。我是 vba 的新手，我认为它需要单独的变量声明。

任何帮助清理我所拥有的并在此处修复该错误都会很棒。（测试：只需放入 strFile 路径的任何内容，并将签名更改为您拥有的任何 Outlook 签名。）

code: Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function
Sub CONFIRMS()

signame = "signature"

Dim EmailItem  As Object
Dim xMailOut As Outlook.MailItem
Dim xOutApp As Outlook.Application
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)

Dim signImageFolderName As String
Dim completeFolderPath As String

Dim StrSignature As String
Dim sPath As String

Dim fto As Object
Dim strFile As String
Dim ftoFile
Dim ftoFldr
Dim dtNew As Date, sNew As String


Set fto = CreateObject("Scripting.FileSystemObject")

 strFile = "G:\Doge\CLIENTS\" 'path to folder

 Set ftoFldr = fto.GetFolder(strFile)

  dtNew = Now() - TimeValue("00:04:30")
  For Each ftoFile In ftoFldr.Files

 If ftoFile.DateCreated > dtNew Then

  sNew = ftoFile.Path

  MSG = "<span>Doge, confirm attached  <br><br> Thank you, <br> 
  <br>Cheems</span><br><br>" _
      

sPath = Environ("appdata") & "\Microsoft\Signatures\" & signame & 
 ".htm"

  signImageFolderName = signame & "_files"
' in outlook HTML forward slashes are used for
' the file path
completeFolderPath = Environ("appdata") & "\Microsoft\Signatures\" 
& signImageFolderName

' If the path and file name given by you is not
' correct then code you insert a blank Signature


If Dir(sPath) <> "" Then
    StrSignature = GetSignature(sPath)
    StrSignature = VBA.Replace(StrSignature, signImageFolderName, completeFolderPath)
Else
    StrSignature = ""
End If


 With xMailOut
    .Subject = "Meme Coin Advisors Confirm"
    .To = "Shiba@inu.com"
    .HTMLBody = MSG & "" & StrSignature
    .Attachments.Add sNew
    .Display
 End With
 Set xMailOut = Nothing
Set xOutApp = Nothing
  End If
Next ftoFile
End Sub
4

0 回答 0