Read text in a file

[Firemaster]

Good afternoon all, I have posted this elsewhere but think i got a bit lost on that site so i thought i would ask here. I am not a VBA coder at all but need to cokmplete a small task. i have 2 scripts the info from is used in the second. So the first piece of the script is to read the contents of a text file lets start there:



So hopefully this will read a file in the location whcih consists of just a few letters and numbers. Then this will be available to use in the second part of the script. Is there anyway of showing that it has read the file contents like temporarily adding a message box to prove it has read the txt file. At the moment it faills over on the 'open the text file

Function TextFile_PullData()
'PURPOSE: Send All Data From Text File To A String Variable
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim strUser As string

' get the current user name
strUser = CreateObject("WScript.Network").UserName
'or use strUser = CreateObject("WScript.Shell").ExpandEnvironmentStr ings("%USERNAME%")

'File Path of Text File
FilePath = "C:\Users\" & strUser & "\Temp\VFile.txt"

'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
MsgBox FileContent

'have the function return the data to the calling code
TextFile_PullData = FileContent
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
Set objItem = GetCurrentItem()
objItem.Subject = "[" + KeyWord + "=" + SaveCode + "] " + objItem.Subject
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

[gmayor]

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.

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

[Firemaster]

The key word is totally irrelevant all this does is adds what we require to an email subject. the script which i have at the moment prompts for the contents of the TXT file and then inserts it into the subject line.
The idea is that the application we have can write the info to a text file which will be something along the lines of FFF00001/001

Then from the script we take the contents of that text file and the script takes that info automaticaly and adds it to the subject line along with the key word. So with the key word it will be TSD=FFF00001/001. Does that make sense?

The location of the file is C:\users\%username%\Temp\VFfile.Txt (As used in CMD)
so out of the script you supplied how is that added?

[gmayor]

You need to change the following section - the rest seems OK

Sub UpdateSubject()
Dim SaveCode As String
Dim KeyWord As String
Dim objItem As Object
Dim strSubject As String
    KeyWord = "TSD"
    SaveCode = TextFile_PullData
    If SaveCode = "" Then Exit Sub
    Set objItem = GetCurrentItem()
    strSubject = objItem.Subject
    objItem.Subject = "[" & KeyWord & "=" & SaveCode & "] " & strSubject
    Set objItem = Nothing
End Sub