PDA

View Full Version : Help Importing XML files - VBA



Foncesa
04-21-2015, 08:29 PM
Hi,

I need help to modify this macros to prompt the user for a xml file to open, [actually the code are for csv file]
Open 1st file and import, prompt for a second xml file, delete the first row of the second file and append all the rows to the bottom of the first file.
Prompt for 3rd xml file (max. Prompt) delete the first row of the third file and append all the rows to the bottom of the second file.
The first line of each file is a heading and I don't want the heading of file2 & file3 to appear in the middle of the rows of data, Delete that row.
All files have the same format of data (and same heading as in row 1)
Ideally, as soon as the data from all the files are together in single sheet I'd like another macro to run.


Sub test()
Dim fn1, fn2, temp As String
fn1 = Application.GetOpenFilename("CSV (*.csv),*.csv")
If fn1 = False Then Exit Sub
fn2 = Application.GetOpenFilename("CSV (*.csv),*.csv")
If fn2 = False Then Exit Sub
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn2).ReadAll
Open fn1 For Append As #1
Print #1, Mid$(temp, InStr(temp, vbCrLf) + 2)
Close #1
Workbooks.Open (fn1)
End Sub

jonh
04-22-2015, 01:44 AM
Sub test()
Const f1 As String = "C:\x.txt"
Const f2 As String = "C:\y.txt"
Const f3 As String = "C:\z.txt"
Const fout As String = "C:\newfile.txt"

If CombineFiles(fout, f1, f2, f3) Then
MsgBox "Done!"
Else
MsgBox "Error!"
End If
End Sub


Function CombineFiles(fout, f1 As String, Optional f2 As String, Optional f3 As String) As Long
On Error GoTo ErrCombineFiles
Dim a(2)
If Len(f1) = 0 Or Len(fout) = 0 Then Exit Function
With CreateObject("Scripting.FileSystemObject")
a(0) = .OpenTextFile(f1).ReadAll
If Len(f2) Then
a(1) = Split(.OpenTextFile(f2).ReadAll, vbNewLine)
a(1)(0) = ""
a(1) = Join(a(1), vbNewLine)
End If
If Len(f3) Then
a(2) = Split(.OpenTextFile(f3).ReadAll, vbNewLine)
a(2)(0) = ""
a(2) = Join(a(2), vbNewLine)
End If
.CreateTextFile(fout, True).write Join(a, "")
End With
ErrCombineFiles:
CombineFiles = Err.Number = 0
End Function