Merge & Extract Textfiles with Excel VBA

[acrolim]

Hello,

I have two text files with the following.

textfile:
001 Cholera
001.0 Cholera
001.1 Cholera
001.9 Cholera, unspecified

002 Typhoid
002.0 Typhoid fever
002.1 Typhoid A
002.2 Typhoid B
002.3 Typhoid
002.9 Typhoid , unspecified

And textfile 2:
00100 ANESTHESIA
00147 ANESTHESIA
00148 ANESTHESIA
00160 ANESTHESIA
00162 ANESTHESIA
00164 ANESTHESIA
00170 ANESTHESIA
00172 ANESTHESIA
00174 ANESTHESIA
00176 ANESTHESIA
00190 ANESTHESIA
00192 ANESTHESIA
00210 ANESTHESIA
00211 ANESTHESIA
00212 ANESTHESIA
00214 ANESTHESIA
00215 ANESTHESIA

I want to merge these two files and print them in one cell in my worksheet "Book1"
Preferebly I would like to extract the text that starts with "001" and ignore the rest.

The code I have is from the MS Blog and joins them but in a textfile, not in the excel file.

Sub AppendFiles1()

Dim SourceNum As Integer
Dim DestNum As Integer
Dim Temp As String

' If an error occurs, close the files and end the macro.
On Error GoTo ErrHandler

' Open the destination text file.
DestNum = FreeFile()
Open "C:\Users\SE-Anne\Desktop\textfile.txt" For Append As DestNum

' Open the source text file.
SourceNum = FreeFile()
Open "C:\Users\SE-Anne\Desktop\textfile2.txt" For Input As SourceNum

' Include the following line if the first line of the source
' file is a header row that you do now want to append to the
' destination file:
Line Input #SourceNum, Temp

' Read each line of the source file and append it to the
' destination file.
Do While Not EOF(SourceNum)
Line Input #SourceNum, Temp
Print #DestNum, Temp
Loop

CloseFiles:

' Close the destination file and the source file.
Close #DestNum
Close #SourceNum
Exit Sub

ErrHandler:
MsgBox "Error # " & Err & ": " & Error(Err)
Resume CloseFiles

End Sub

Please let me know the best way to this. Thanks!!

 

[netuser]

There was some issue with line break after 2nd text file, I have corrected it :

Sub importtxt()

Dim myFile As String, myFile2 As String, text As String, textline As String

myFile = "C:\Temp\textfile1.txt" ' Change to your text file path and name
myFile2 = "C:\Temp\textfile2.txt" ' Change to your text file path and name

Open myFile For Input As #1
Do Until EOF(1)
    Line Input #1, textline
    If Left(textline, 3) = "001" Then
    If text = "" Then
    text = textline
    Else
    text = text & vbCrLf & textline
     End If
     End If
Loop
Close #1

If text <> "" Then
Range("A1").Value = text & vbCrLf
End If

text = ""

Open myFile2 For Input As #2
Do Until EOF(2)
    Line Input #2, textline
    If Left(textline, 3) = "001" Then
    If text = "" Then
    text = textline
    Else
    text = text & vbCrLf & textline
     End If
     End If
Loop

Close #2

Range("A1").Value = Range("A1").Value & text


End Sub

 

[acrolim]

Yes it did! Thank you!!

 

[acrolim]

I have an extra question a bit related.
Do you know how I could import and read a textfile and paste it in a cell but in this format:

TxtRng.Value = "This is a string" & [textfile content] & "continue string"

I am not sure if I should set a variable to the textfile content.

 

[netuser]

You want your text after each line of text file ? or just at start and end of textfile ?

If it is on Full text file change the last line of my code to this :

Range("A1").Value = "This is a string " & Range("A1").Value & text & " continue string"

if it is after each line then change if block of file1 and file2 code to this :

If text = "" Then
    text = "This is a string " & textline & " continue string"
    Else
    text = text & vbCrLf & "This is a string " & textline & " continue string"

I can repost full code if it confuse you. but it is really easy.