Excel macro Macros-Specify the path under two TXT file copy, import and contrast in Excel

Because the Excel format is pasted without time, write only the key VBA code and TXT document format example '

Attribute vb_name = "Copyanddiffer"

' 2015/06/24 ADD by Maouizayoi

Option Explicit

' Excute Interface.
Sub Copyanddiffer ()

' Define variables
Dim Ccnsht as Object ' Ccnsht is named for the current console sheet.
Dim Pathrng as Range
Dim Filenamerng as Range
Dim Fieldsrng as Range
Dim Arng as Range
Dim Brng as Range

Dim Itemfilter, strpath, strFileInfo, Endmark, FiA, FiB, Strinput, Strdata, Pathfilter, strTmpPath, STRTMPFN as String

Dim Parentpath as String

Dim I, J as Long

' Initialize values
Set Ccnsht = Activesheet.usedrange
Set pathrng = Ccnsht.range ("A2")
Set filenamerng = Ccnsht.range ("B2")
Set fieldsrng = Ccnsht.range ("C2")
Set arng = Ccnsht.range ("D2")
Set brng = Ccnsht.range ("F2")

Itemfilter = ":"
Pathfilter = "Path:"
strpath = "Path"
strFileInfo = "FileName"
Endmark = "END"

Parentpath = Findparentpath

FiA = Parentpath & "\src\a.txt"
FiB = Parentpath & "\src\b.txt"

i = 1
j = 2

' Main handle
' Loop1 to deal with result of FiB
Open FiA for Input as #1
Do and not EOF (1)

' One row data from TXT file
Line Input #1, strinput

Strdata = Strinput


If InStr (strdata, Pathfilter) > 0 Then
Dim strLine1 (0 to 1) as String
StrLine1 (0) = strpath
StrLine1 (1) = Split (Strdata, Pathfilter) (1)


If strLine1 (0) = Strpath Then

' Path cell name pair value.
Cells (j, Pathrng.column) = StrLine1 (1)

strTmpPath = strLine1 (1)
End If
Else
Dim StrLine2 () as String
StrLine2 = Split (strdata, Itemfilter)

If strLine2 (0) = Strpath Then

' Path cell name pair value.
Cells (j, Pathrng.column) = StrLine2 (1)

strTmpPath = StrLine2 (1)
ElseIf strLine2 (0) = strFileInfo Then

' FileName cell name pair value.
Cells (j, Filenamerng.column) = StrLine2 (1)

STRTMPFN = StrLine2 (1)
ElseIf strLine2 (0) = Endmark Then

' A file Info group is over, evaluating next group RowNo.
' J = j + 1
Else

' Field cell ' name pair value.
Cells (j, pathrng.column) = strTmpPath
Cells (j, filenamerng.column) = STRTMPFN
Cells (j, Fieldsrng.column) = StrLine2 (0)
Cells (j, Arng.column) = StrLine2 (1)

j = j + 1
End If
End If

i = i + 1
Loop
Close #1

i = 1
j = 2
strTmpPath = ""
STRTMPFN = ""

' Loop2 to deal with result of B
Open FiB for Input as #1
Do and not EOF (1)

' One row data from TXT file
Line Input #1, strinput

Strdata = Strinput


If InStr (strdata, Pathfilter) > 0 Then
Dim StrLine3 (0 to 1) as String
StrLine3 (0) = strpath
StrLine3 (1) = Split (Strdata, Pathfilter) (1)


If strLine3 (0) = Strpath Then

' Path cell name pair value.
' Cells (j, Pathrng.column) = StrLine3 (1)

strTmpPath = StrLine3 (1)
End If
Else
Dim strLine4 () as String
StrLine4 = Split (strdata, Itemfilter)

If strLine4 (0) = Strpath Then

' Path cell name pair value.
' Cells (j, Pathrng.column) = StrLine4 (1)

strTmpPath = strLine4 (1)
ElseIf strLine4 (0) = strFileInfo Then

' FileName cell name pair value.
' Cells (j, Filenamerng.column) = StrLine4 (1)

STRTMPFN = strLine4 (1)
ElseIf strLine4 (0) = Endmark Then

' A file Info group is over, evaluating next group RowNo.
' J = j + 1
Else

' Field cell ' name pair value.
' Cells (j, pathrng.column) = strTmpPath
' Cells (j, filenamerng.column) = STRTMPFN
' Cells (j, Fieldsrng.column) = strLine4 (0)
Cells (j, Brng.column) = StrLine4 (1)

j = j + 1
End If
End If

i = i + 1
Loop
Close #1

End Sub

' To find Parentpath of Excel
Function Findparentpath ()
Dim Curpath as String
Dim Temp as Integer
Dim Strpos as Integer

Curpath = Thisworkbook.path

For temp = Len (Curpath) to 1 Step-1
Strpos = InStr (temp, curpath, "\", vbTextCompare)
If Strpos <> 0 Then
Exit for
End If
Next Temp

Findparentpath = Mid (Curpath, 1, strPos-1)
End Function

------------------------------------------------------------------------------

TXT file format e.g.

Path:d:\work\test.jpg
FileName:test.jpg
Param1:1
....
END
Next item Info
...
END

Excel macro Macros-Specify the path under two TXT file copy, import and contrast in Excel