Change text in Outlook signature files with VBScript

vbscript-mini-logo

Some guy at work decided to change our Facebook group name and effectively remove the old Facebook group link. We used that old link for all of our employee email signatures and of course it all got b0rked. Only way to deal with this was to write a quick VBS script and put it into a GPO Logon. It seemed to fix it, day was saved!
Script can be found here: http://9v.lt/projects/other/change_signature.vbs

Here’s the script for quick review:

  1. '=================================================
  2. '  Description:
  3. '       Changes a string in a HTM file for Outlook signatures.
  4. '=================================================
  5.  
  6. Set wshShell = CreateObject("WScript.Shell")
  7. Set objFS = CreateObject("Scripting.FileSystemObject")
  8.  
  9. Const sigDir = "%appdata%\Microsoft\Signatures"
  10. Const sigFTmp = "_tmp"
  11. Const oldLink = "qwerty"
  12. Const oldLink1 = "azerty"
  13. Const newLink = "asdfg"
  14.  
  15. If (objFS.FolderExists(wshShell.ExpandEnvironmentStrings(sigDir))) Then
  16.     Dim objFile
  17.     For Each objFile In objFS.GetFolder(wshShell.ExpandEnvironmentStrings(sigDir)).Files
  18.         'only proceed if there is an extension on the file.
  19.         If (InStr(objFile.Name, ".") > 0) Then
  20.             'If the file's extension is "htm", write the path to the output file.
  21.             If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".htm") Then
  22.                 Set textStream = objFS.GetFile(objFile.Path).OpenAsTextStream(1, -2)
  23.                 Set objOutFile = objFS.CreateTextFile(objFile.Path & sigFTmp, True)
  24.                 REM x = MsgBox(objFile.Path & sigFTmp, 0, "qqqq")
  25.                 Do Until textStream.AtEndOfStream
  26.                     strLine = textStream.ReadLine
  27.                     If (InStr(strLine, oldLink) > 0) Then
  28.                         strLine = Replace(strLine, oldLink, newLink)
  29.                         REM x = MsgBox(strLine, 0, "wwwww")
  30.                     End If
  31.                     If (InStr(strLine, oldLink1) > 0) Then
  32.                         strLine = Replace(strLine, oldLink1, newLink)
  33.                         REM x = MsgBox(strLine, 0, "eeee")
  34.                     End If
  35.                     objOutFile.WriteLine(strLine)
  36.                 Loop
  37.                 objOutFile.Close()
  38.                 textStream.Close()
  39.                 oldFilename = objFile.Path
  40.                 objFS.DeleteFile(oldFilename)
  41.                 objFS.MoveFile oldFilename & sigFTmp, oldFilename
  42.             End If
  43.         End If
  44.     Next
  45. End If

6 comments

  1. danderson says:

    I found this code which is very helpful for replacing keywords within Outlook signature files. However, when I repurpose the code for a .txt file, it gives a runtime error at line 35 “objOutFile.WriteLine(strLine)”, and says “invalid procedure call or argument” error code 800A0005.

    It works fine when used on “.htm”, “.rtf”, and “.log” files (I changed line 21 for this).

    Any advice?

  2. Kulverstukas says:

    It’s most likely you have a typo somewhere. Can you post your code?

  3. danderson says:

    Sure thing.

    For now I’ve been keeping the file in the AppData folder. It’s currently pulling files from a directory on the Desktop, for testing purposes. The file modifies .htm and .rtf just fine, but doesn’t work for .txt’s.

    *edit: sorry about the formatting, it’s messed up the indentation.

    1. '=================================================
    2. '  7/14/18 copied/modified from   http://9v.lt/blog/change-outlook-signature-vbs/
    3. '  Description:
    4. '       Changes a string in a HTM file for Outlook signatures.
    5. '=================================================
    6.  
    7. Set wshShell = CreateObject("WScript.Shell")
    8. Set objFS = CreateObject("Scripting.FileSystemObject")
    9.  
    10.  
    11. Const sigDir = "..DesktopDestination"
    12. 'COMMENT correct to: Const sigDir = "RoamingMicrosoftSignatures"
    13. Const sigFTmp = "_tmp"
    14. Const oldString = "!Name"
    15. Const oldString1 = "azerty"
    16. 'COMMENT: is the above line necessary?
    17. dim newString
    18. newString = InputBox("What's your name?", "Prompt", "!Name")
    19.  
    20. ReplaceKeyword ".htm"
    21. ReplaceKeyword ".rtf"
    22. ReplaceKeyword ".txt"
    23.  
    24. WScript.Echo "All instances of " & oldString & " have been replaced by " & newString & "."
    25.  
    26.  
    27. '---------------------------------------
    28. 'Subroutines below
    29. '---------------------------------------
    30.  
    31. sub ReplaceKeyword(myFileExtension)
    32. 	If (objFS.FolderExists(wshShell.ExpandEnvironmentStrings(sigDir))) Then
    33. 	    Dim objFile
    34. 	    For Each objFile In objFS.GetFolder(wshShell.ExpandEnvironmentStrings(sigDir)).Files
    35. 	        'only proceed if there is an extension on the file.
    36. 	        If (InStr(objFile.Name, ".") > 0) Then
    37. 	            'If the file's extension is "htm", write the path to the output file.
    38. 	            If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = myFileExtension ) Then
    39. 	                Set textStream = objFS.GetFile(objFile.Path).OpenAsTextStream(1, -2)
    40. 	                Set objOutFile = objFS.CreateTextFile(objFile.Path & sigFTmp, True)
    41. 	                REM x = MsgBox(objFile.Path & sigFTmp, 0, "qqqq")
    42. 	                Do Until textStream.AtEndOfStream
    43. 	                    strLine = textStream.ReadLine
    44. 	                    If (InStr(strLine, oldString) > 0) Then
    45. 	                        strLine = Replace(strLine, oldString, newString)
    46. 	                        REM x = MsgBox(strLine, 0, "wwwww")
    47. 	                    End If
    48. 	                    If (InStr(strLine, oldString1) > 0) Then
    49. 	                        strLine = Replace(strLine, oldString1, newString)
    50. 	                        REM x = MsgBox(strLine, 0, "eeee")
    51. 	                    End If
    52. 	                    objOutFile.WriteLine(strLine)
    53. 	                Loop
    54. 	                objOutFile.Close()
    55. 	                textStream.Close()
    56. 	                oldFilename = objFile.Path
    57. 	                objFS.DeleteFile(oldFilename)
    58. 	                objFS.MoveFile oldFilename & sigFTmp, oldFilename
    59. 	            End If
    60. 	        End If
    61. 	    Next
    62. 	    REM WScript.Echo "Folder Existed"
    63. 	Else 
    64. 	    WScript.Echo "Folder did not exist"
    65. 	End If
    66. 	WScript.Echo "step complete"
    67. End Sub
    68. 'ends ReplaceKeyword() function
    69. '-----------------------
  4. danderson says:

    I’m actually using something else entirely than the VBScript, so the fix is no longer necessary. However, I’m still curious to know what’s causing the issue for txt files (but not htm/rtf).

    Thanks!

  5. Kulverstukas says:

    @danderson: I’ve tested your code, seems to work for me. Might be an issue with your environment though, like the file has some permission issues or something?
    This is the code that I used:

    1. '=================================================
    2. '  7/14/18 copied/modified from   http://9v.lt/blog/change-outlook-signature-vbs/
    3. '  Description:
    4. '       Changes a string in a HTM file for Outlook signatures.
    5. '=================================================
    6. Set wshShell = CreateObject("WScript.Shell")
    7. Set objFS = CreateObject("Scripting.FileSystemObject")
    8.  
    9. Const sigDir = "testfolder"
    10. Const sigFTmp = "_tmp"
    11. Const oldString = "ipsum"
    12.  
    13. dim newString
    14. newString = InputBox("What's your name?", "Prompt", "!Name")
    15. ReplaceKeyword ".txt"
    16. WScript.Echo "All instances of " & oldString & " have been replaced by " & newString & "."
    17.  
    18. '---------------------------------------
    19. 'Subroutines below
    20. '---------------------------------------
    21. sub ReplaceKeyword(myFileExtension)
    22.     If (objFS.FolderExists(wshShell.ExpandEnvironmentStrings(sigDir))) Then
    23.         Dim objFile
    24.         For Each objFile In objFS.GetFolder(wshShell.ExpandEnvironmentStrings(sigDir)).Files
    25.             'only proceed if there is an extension on the file.
    26.             If (InStr(objFile.Name, ".") > 0) Then
    27.                 'If the file's extension is "htm", write the path to the output file.
    28.                 If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = myFileExtension ) Then
    29.                     Set textStream = objFS.GetFile(objFile.Path).OpenAsTextStream(1, -2)
    30.                     Set objOutFile = objFS.CreateTextFile(objFile.Path & sigFTmp, True)
    31.                     REM x = MsgBox(objFile.Path & sigFTmp, 0, "qqqq")
    32.                     Do Until textStream.AtEndOfStream
    33.                         strLine = textStream.ReadLine
    34.                         If (InStr(strLine, oldString) > 0) Then
    35.                             strLine = Replace(strLine, oldString, newString)
    36.                             REM x = MsgBox(strLine, 0, "wwwww")
    37.                         End If
    38.                         objOutFile.WriteLine(strLine)
    39.                     Loop
    40.                     objOutFile.Close()
    41.                     textStream.Close()
    42.                     oldFilename = objFile.Path
    43.                     objFS.DeleteFile(oldFilename)
    44.                     objFS.MoveFile oldFilename & sigFTmp, oldFilename
    45.                 End If
    46.             End If
    47.         Next
    48.         REM WScript.Echo "Folder Existed"
    49.     Else 
    50.         WScript.Echo "Folder did not exist"
    51.     End If
    52.     WScript.Echo "step complete"
    53. End Sub
    54. 'ends ReplaceKeyword() function
  6. danderson says:

    Sounds good, I’ll play around with it further. I’m obviously new to VBScript so at least it isn’t the code. Thanks a bunch!

Leave a Reply

Your email address will not be published. Required fields are marked *