Question

我找到了一个非常有用的VBScript，它添加了一个Send To上下文菜单项，允许用来发送多个文档作为Outlook邮件模板的附件。我目前使用类似的脚本根据一些用户输入生成电子邮件，并想知道如何更新此脚本以包含To字段的字段或发送到地址。

最终，我希望从用户，任何选定的附件，主题，正文中获取发送地址，并自动发送电子邮件，而不必强制用户单击Outlook中的发送按钮。但是现在，我很高兴只是获取并插入发送到地址并将所选文件添加为附件。

原谅我，我几乎不了解VBScript，我甚至不确定我想做什么是可能的。如果您有任何建议，请随时分享！

这是VBScript：

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSendTo = WshShell.SpecialFolders("SendTo") & "\"
strShortcutFileName = strSendTo & "\" & "Mail Recipient (as Path)" & ".lnk"
strMsg = "Completed!" & Chr(10) & Chr(10) & "SendLinkToMail.vbs - © 2010 Ramesh Srinivasan" & Chr(10) & "Visit us at http://www.winhelponline.com/blog/"
Set objArgs = WScript.Arguments
If WScript.Arguments.Count >  0 Then

    For I = 0 to objArgs.Count - 1
        If Left(WScript.Arguments.Item(I), 2) = "\\" Then
            strLinks =  strLinks & "%0A" & "%3C" & Replace(WScript.Arguments.Item(I)," ", "%20") & "%3E"
        Else
            strLinks =  strLinks & "%0A" & "%3C" & "file:///" & Replace(WScript.Arguments.Item(I)," ", "%20") & "%3E" & "%0A"
        End If      
    Next

    'Customize the Recipient Email and Subject here
    strRecipientEMail = ""
    strMailSubject = "File Paths"

    strMailSubject = Replace(strMailSubject," ","%20")
    On Error Resume Next

    WshShell.run "mailto:" & strRecipientEMail & "?Subject=" & strMailSubject & "&body=" & strLinks

    If Err <> 0 Then
        Select Case Err.Number
            Case 70
                If MsgBox ("Cannot send to mail as the parameters are too long. Do you want to output the file paths to a text file instead?",vbYesNo) = vbYes Then
                    strLinks =  Replace(strLinks,"%20"," ")
                    strLinks =  Replace(strLinks,"%0A",vbCrLf)
                    txtFilePaths= WshShell.ExpandEnvironmentStrings("%TEMP%") & "\FilePaths.txt"
                    Set b = objFSO.CreateTextFile (txtFilePaths,true)
                    b.WriteLine strLinks
                    b.close
                    WshShell.run "notepad.exe " & txtFilePaths
                End If

            Case Else
                MsgBox "Error " & Err.Number & " occurred."

        End Select
    End If
    On Error Goto 0 
Else
    rtn= Trim(UCase(InputBox ("Type INSTALL to add the MAIL RECIPIENT (as Path) to the Send To menu, or type UNINSTALL if you wish to remove the option.",  "Configuring SendLinkToMail.vbs...", "INSTALL")))
    If rtn = "INSTALL" Then RunInstall
    If rtn = "UNINSTALL" Then RunUninstall
End If

Sub RunInstall
    Set oShellLink = WshShell.CreateShortcut(strShortcutFileName)
    oShellLink.TargetPath = WScript.ScriptFullName
    oShellLink.IconLocation = "sendmail.dll,-2001"
    oShellLink.Save
    MsgBox strMsg, vbokonly,"Installed"
End Sub

Sub RunUninstall
    if objFSO.fileexists(strShortcutFileName) then objFSO.deletefile(strShortcutFileName)
    MsgBox strMsg, vbokonly,"Uninstalled"
End Sub

这是当前的脚本（批处理）：

Title GFI Fax Maker
Echo off
cls
:Start
Set Name=_
Set SurName=_
Set Company=_
Set Department=_

Set /P Name=Type the Recipient's First name: 
Set /P SurName=Type the Recipient's Last name: 
Set /P Company=Type the Recipient's Company name: 
:: Set /P Department=Type the Recipient's Department name: 
Set /P Number=Type the Recipient's Fax Number: 

cls
:Verify
Echo ________________
Echo Recipient's First Name: %Name%
Echo Recipient's Last Name: %SurName%
Echo Recipient's Company Name: %Company%
:: Echo Recipient's Department Name: %Department%
Echo Recipient's Fax Number: %Number%
Set /P Correct=Is this correct? 
If %Correct%==n GOTO Start
If %Correct%==N GOTO Start

if %Number:~0,2%==91 "C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE" /c ipm.note /m %Name%.%Company%.%SurName%.%Department%.%Number%@hspsfax.com
if %Number:~0,2%==91 GOTO END

if %Number:~0,1%==1 "C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE" /c ipm.note /m %Name%.%Company%.%SurName%.%Department%.9%Number%@hspsfax.com
if %Number:~0,1%==1 GOTO End

"C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE" /c ipm.note /m %Name: =%.%Company: =_%.%SurName: =%.%Department: =_%.91%Number: =%@hspsfax.com

:End

Answer 1

您可以使用InputBox用户输入收件人邮件地址。

strRecipientEMail = InputBox("Enter recipient address", "SendLinkToMail", "...")

修改VBScript以将电子邮件发送到用户定义的地址

1 个答案: