Replace Text and Save .TXT 1

[VBegin]

Hey,

I have this code to download the attachments in my outlook inbox to a specified folder as .txt files. I was wondering if anyone had a way that I could replace the "<" and ">" characters in the files (as original filetype is .xml) with a "^". I would prefer to do this all in the same step as ultimately I am using this program to create a monthly database in which will be about 1000 files a month. Here is what I have so far:

Sub saveAttachments()
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myAttachment As Outlook.Attachment
Dim myItems As Outlook.Items
Dim strFolder As String
Dim myFolder As Object
Dim myExplorer As Outlook.Explorer
Dim obj As Outlook.MailItem
Dim LResult As String



On Error Resume Next

strFolder = "H:\DUMP\"

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myNameSpace.PickFolder
Set myExplorer = myFolder.GetExplorer
Set myItems = myFolder.Items
'myExplorer.Display

For Each obj In myItems
For Each myAttachment In obj.Attachments
myAttachment.SaveAsFile strFolder _
& myAttachment.DisplayName & ".TXT"
Next
Next

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myExplorer = Nothing
Set myItems = Nothing

End Sub


Thanks for your help!

 

[jges]

Here is some VBScript that will do what you want. You should be able to use most of the code directly in VBA, you will have to add a loop to capture all of your files (or incorporate it into your existing loop).

Set objFSO = CreateObject("Scripting.FileSystemObject")

dim filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const fmtUnicode = -1, fmtASCII = 0, fmtDefault = -2
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

'change the following file path to point to your file
Set filetxt = objFSO.GetFile("H:\changeme.txt")
Set ts = filetxt.OpenAsTextStream(ForReading, TristateUseDefault)

Dim arrFileLines()
i = 0
Do Until ts.AtEndOfStream
Redim Preserve arrFileLines(i)
arrFileLines(i) = ts.ReadLine
arrFileLines(i) = Replace(arrFileLines(i), "<", "^")
arrFileLines(i) = Replace(arrFileLines(i), ">", "^")
i = i + 1
Loop

ts.close
set ts = nothing

Set ts = filetxt.OpenAsTextStream(ForWriting, True)
for i = 0 to ubound(arrFileLines)
ts.WriteLine(arrfileLines(i))
next

ts.close
set ts = nothing
set filetxt = nothing