View Single Post
 
Old 11-22-2018, 09:31 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,106
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

It is not clear what the relevance of the keyword is or what the content of the textfile is, but the following provides the additional error trapping you need.
Code:
Option Explicit

 Function TextFile_PullData() As String
'Graham Mayor - https://www.gmayor.com - Last updated - 23 Nov 2018 

 'PURPOSE: Send All Data From Text File To A String Variable
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim fso As Object
    'File Path of Text File
    FilePath = Environ("USERPROFILE") & "\Temp\VFile.txt"
    'or for the User Temp folder
    'FilePath = Environ("TEMP") & "\VFile.txt"
    'However these are not the same folder

    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(FilePath) Then
        'Determine the next file number available for use by the FileOpen function
        TextFile = FreeFile
        'Open the text file
        Open FilePath For Input As TextFile
        'Store file content inside a variable
        FileContent = Input(LOF(TextFile), TextFile)
        'Close Text File
        Close TextFile
        'Report Out Text File Contents
        TextFile_PullData = FileContent
    Else
        TextFile_PullData = ""
        Beep
        MsgBox FilePath & vbCr & " is not available"
    End If
    Set fso = Nothing
End Function

'Second part it takes the Information and adds it to this script in the TextFile_PullData

Sub UpdateSubject()
Dim SaveCode As String
Dim KeyWord As String
Dim objItem As MailItem

    KeyWord = "TSD"
    SaveCode = TextFile_PullData
    If SaveCode = "" Then Exit Sub
    Set objItem = GetCurrentItem()
    objItem.Subject = "[" + KeyWord + "=" + SaveCode + "] " + objItem.Subject
    Set objItem = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.currentItem
    End Select

    Set objApp = Nothing
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote