использование обратной косой черты или хэштега в текстовом поле в макросе с включенным словом doc

Question

У меня есть документ с поддержкой макросов Word, в котором есть несколько установленных текстовых полей, которые необходимо заполнить до того, как документ можно будет отправить на несколько адресов электронной почты. У меня проблема в том, что работники здесь любят сокращать все, например, левой рукой = L / H и т. Д. Документ, который у меня есть, не распознает / или #. Текстовое поле является свободным текстовым полем, которое требуется завершить. Когда они помещают / или \ или # в одно из обязательных текстовых полей, документ не знает, что делать - как будто он не может их обработать

{`Если ActiveDocument.ProtectionType <> wdNoProtection Тогда ActiveDocument.Unprotect "Pass1" Конец, если

strTempFolder = GetTempFolder()


strDate = ActiveDocument.SelectContentControlsByTag("EventDate").Item(1).Range.Text

If IsDate(strDate) Then
    strDate = Format(strDate, "yyyy-mm-dd")
Else
    MsgBox "Please select an event date.", vbExclamation, "Date Error"
    Exit Sub
End If

strNoti = ActiveDocument.SelectContentControlsByTag("NotificationNumber").Item(1).Range.Text

If Not IsNumeric(strNoti) Or Len(strNoti) <> 9 Then
    MsgBox "Please enter a valid notification number.",  vbExclamation, "Notification Error"
    Exit Sub
End If

strShortText = ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).Range.Text

If Left(strShortText, 5) = "Enter" Then
    MsgBox "Please enter short text.", vbExclamation, "Title Not Entered"
    Exit Sub
End If

response = MsgBox("Confirm you have completed the data entry and wish to now send this document? WAIT FOR EMAILS TO PROCESS!", vbExclamation + vbYesNo, "Document Send Confirmation")
If response = vbNo Then
    MsgBox "Document not sent", vbInformation, "Document Not sent"
    Exit Sub
End If

strTitle = strDate & " " & strNoti & " " & strShortText
strFilename = strDate & " " & strNoti & " " & strShortText & ".docm"
strFullFileNameDocm = strTempFolder & "\" & strFilename
ActiveDocument.SaveAs FileName:=strFullFileNameDocm

strFilename = strDate & " " & strNoti & " " & strShortText & ".docx"
strFullFileNameDocx = strTempFolder & "\" & strFilename

Application.Documents.Add ActiveDocument.Fullname


'Remove button
ActiveDocument.Shapes("Control 3").Select
Selection.ShapeRange.Delete

'Save copy
ActiveDocument.SaveAs strFullFileNameDocx


'Old file location for doc save..    "\\necmacfil01 \bcc_data\Transfer\Events\"


'   strTo = "Sue.Jones1@ton.com"
strTo = "nswec.mac.mre@ton.com"
Call SendDocumentAsAttachment(strFullFileNameDocx, strTitle, strTo)

Call RemoveSection2ToEnd

strPDFSharePointFolder  = "https://spo.ton.com/sites/COLMTAmacdata/Event%20Notifications/"
strFilename = strDate & " " & strNoti & " " & strShortText & ".pdf"
strFullFileNamePDF = strPDFSharePointFolder & strFilename

ActiveDocument.SaveAs FileName:=strFullFileNamePDF, FileFormat:=wdFormatPDF

 '  strTo = "Sue.Jones1@ton.com"
strTo = "DL-COL-NEC-MACEventNotification@ton.com"
Call SendDocumentAsAttachment(strFullFileNamePDF, strTitle, strTo)

'Close copy
Application.DisplayAlerts = False
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Application.DisplayAlerts = True

MsgBox "Document sent as required, this document will now be closed.",   vbInformation, "Document Sent"

Application.DisplayAlerts = False
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Application.DisplayAlerts = True


End Sub


Sub SendDocumentAsAttachment(strFullFileName As String, strTitle As String, strTo As String)


Dim oOutlookApp As Outlook.Application
Dim strBody As String


 'You'll need to add the Outlook Object Library to VBA Tools References

Dim oItem As Outlook.MailItem

On Error Resume Next

If Len(ActiveDocument.Path) = 0 Then 'Document has not been saved

    'so save it
    ' ActiveDocument.Save

End If

 'see if Outlook is running and if so turn your attention there

Set oOutlookApp = GetObject(, "Outlook.Application")

If Err <> 0 Then 'Outlook isn't running

     'So fire it up

    Set oOutlookApp = CreateObject("Outlook.Application")


End If

 'Open a new e-mail message

Set oItem = oOutlookApp.CreateItem(olMailItem)




    .Display
    .To = strTo 'send to this address
    .CC = ""
    .BCC = ""
    strBody = "<p>All</p>" & vbCr & vbCr & _
              "<p>Please find attached event notification.</p>"

    .HTMLBody = strBody & .HTMLBody
    .Subject = strTitle 'This is the message subject


    .Attachments.Add Source:=strFullFileName
    .Send
End With


Set oItem = Nothing

Set oOutlookApp = Nothing

End Sub



Sub RemoveSection2ToEnd()

Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=2, Name:=""

With Selection.PageSetup
    .LineNumbering.Active = False
    .Orientation = wdOrientLandscape
    .TopMargin = CentimetersToPoints(0)
    .BottomMargin = CentimetersToPoints(0)
    .LeftMargin = CentimetersToPoints(1.27)
    .RightMargin = CentimetersToPoints(1.27)
    .Gutter = CentimetersToPoints(0)
    .HeaderDistance = CentimetersToPoints(0.75)
    .FooterDistance = CentimetersToPoints(0.18)
    .PageWidth = CentimetersToPoints(29.7)
    .PageHeight = CentimetersToPoints(21)
    .FirstPageTray = wdPrinterDefaultBin
    .OtherPagesTray = wdPrinterDefaultBin
    .SectionStart = wdSectionNewPage
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .VerticalAlignment = wdAlignVerticalTop
    .SuppressEndnotes = False
    .MirrorMargins = False
    .TwoPagesOnOne = False
    .BookFoldPrinting = False
    .BookFoldRevPrinting = False
    .BookFoldPrintingSheets = 1
    .GutterPos = wdGutterPosLeft
End With

Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=2, Name:=""
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=2

End Sub}