3

我刚刚从我们的 IT 人员那里升级到我工作的 Office 2010，以便我可以检查我在办公室编写的 VBA 脚本的功能。到目前为止，我遇到的唯一一个是 Outlook 2010，如下所示。我在每一端都用 3 个 * 标记了那些不起作用的行。有人可以建议吗？我在网上找不到任何解决方案（地址中的....仅用于删除此处的文件路径）

Sub UpdatedQMISReply()

Location = InputBox("Please enter the UNC (http://) path for the new file", "UNC location")
Location2 = InputBox("Please enter the QMIS path for the new file", "UNC location")

'
' UpdatedQMISReply Macro
' Insert QMIS Document Updated text
'
    ActiveInspector.WordEditor.Application.Selection.TypeText Text:="Dear User,"
    ActiveInspector.WordEditor.Application.Selection.TypeParagraph
    ActiveInspector.WordEditor.Application.Selection.TypeParagraph
    ActiveInspector.WordEditor.Application.Selection.TypeText Text:="This email is to confirm that your recent file update request to QMIS has now been completed. I have uploaded all the requested files and have saved a copy into the archive folder "
ActiveInspector.WordEditor.Application.Selection.TypeText Text:="(if an old file existed)."
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeText Text:="The location on QMIS for the uploaded document is: "


***ActiveInspector.WordEditor.Application.Selection.Hyperlinks.Add Anchor:=Selection.Range, Address:=Location, SubAddress:="", ScreenTip:="", TextToDisplay:=Location2***


ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeText Text:="If your update was concerning a Health & Safety Document such as a Risk Assessment, or Safe System of Work, then please note that the naming convention for these documents is changing, also the location of the document may change without prior warning as the QMIS infrastructure is modified."
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeText Text:="Should you have any further queries regarding this update then please do not hesitate to contact me"
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeParagraph
ActiveInspector.WordEditor.Application.Selection.TypeText Text:="Regards"
End Sub
Sub DocumentRenewalNeeded()
'
' QMIS.DocumentRenewalNeeded Macro
' Macro created 26/10/2011 by stefan.wright
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.Subject = "QMIS Document Review Needed"


***myItem.Attachments.Add "\\.........\sites\..........\.........\DOCUMENT UPDATE TRACKER\.............xls"***


myItem.Display

Selection.TypeText Text:="Dear User,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="This email is to inform you that you have documents that are currently out of date on QMIS Document Library. These documents could either be on the Quality worksheet or the HS worksheet so please ensure you check both. Please could you view the QMIS Document Updater Spreadsheet to view the documents which you are responsible for, This can be done by clicking the small arrow in the box which says 'Responsible Person' and then selecting your name, if you then do the same in the 'Colour Code' box and select '2' or '3' you will find the documents which should have been reviewed. If you should find that you are listed on a document and this is incorrect then please let me know and if possible advise me of who should be responsible for that document."
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="The spreadsheet of QMIS updates is attached to this email."
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Should you have any further queries regarding this update then please do not hesitate to contact me.    This email will be sent out monthly to those people who have outstanding updates to be completed."
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Regards"
End Sub
4

1 回答 1

2

未经测试

试试这个

Sub UpdatedQMISReply()
    Dim msg1 As String, msg2 As String
    Dim doc As Object, sel As Object
    Dim Location, Location2

    msg1 = "Please enter the UNC (http://) path for the new file"
    msg2 = "Please enter the QMIS path for the new file"

    Location = InputBox(msg1, "UNC location")
    Location2 = InputBox(msg2, "UNC location")

    Set doc = ActiveInspector.WordEditor
    Set sel = doc.Application.Selection

    With sel
        .TypeText Text:="Dear User,"
        .TypeParagraph
        .TypeParagraph
        .TypeText Text:="This email is to confirm that your recent " & _
                        "file update request to QMIS has now been " & _
                        "completed. I have uploaded all the requested " & _
                        "files and have saved a copy into the archive folder "
        .TypeText Text:="(if an old file existed)."
        .TypeParagraph
        .TypeParagraph
        .TypeText Text:="The location on QMIS for the uploaded document is: "

        .Hyperlinks.Add Anchor:=.Range, Address:=Location, SubAddress:="", ScreenTip:="", TextToDisplay:=Location2

        .TypeParagraph
        .TypeParagraph
        .TypeText Text:="If your update was concerning a Health & Safety " & _
                        "Document such as a Risk Assessment, or Safe System" & _
                        " of Work, then please note that the naming " & _
                        "convention for these documents is changing, also " & _
                        "the location of the document may change without " & _
                        "prior warning as the QMIS infrastructure is modified."
        .TypeParagraph
        .TypeParagraph
        .TypeText Text:="Should you have any further queries regarding " & _
                        "this update then please do not hesitate to contact me"
        .TypeParagraph
        .TypeParagraph
        .TypeText Text:="Regards"
    End With
End Sub

或者在您的实际代码中，替换

***ActiveInspector.WordEditor.Application.Selection.Hyperlinks.Add Anchor:=Selection.Range, Address:=Location, SubAddress:="", ScreenTip:="", TextToDisplay:=Location2***

和

ActiveInspector.WordEditor.Application.Selection.Hyperlinks.Add _
Anchor:=ActiveInspector.WordEditor.Application.Selection.Range, _
Address:=Location, SubAddress:="", ScreenTip:="", TextToDisplay:=Location2
于 2012-05-24T14:58:42.453 回答