alexa-tracking

Main Content

1024
1024
KASKUS
51
244
https://www.kaskus.co.id/thread/53215d48f9ca17f85e8b4601/vba-xml-exporting-procedure-to-xls
VBA XML Exporting Procedure to XLS
halo mastah,

ane mau minta bantuan nih, ane lagi bikin converter dari XML ke excel dengan VBA, nah, ane lagi bingung nih pas mau save data hasil convertnya ke file xls laen nge bug terus, berikut mantra yang udah ane buat (selalu keluar error message "select method of range class failed" pas di bagian export):
Code:

Public path As String
Public tgl As String
Public bln As String
Public prod As String
Public batch As String
Public dat As String

Option Explicit

Private Sub DTPicker1_Change()
range("C1048576").Value = DTPicker1.Value

'isi combobox
ComboBox1.Clear
ComboBox2.Clear

ComboBox1.AddItem "1"
ComboBox1.AddItem "2"
ComboBox1.AddItem "3"
ComboBox1.AddItem "4"

ComboBox2.AddItem "CC"
ComboBox2.AddItem "PL"

End Sub

Private Sub ComboBox1_Change()
range("D1048576").Value = ComboBox1.Value
End Sub

Private Sub ComboBox2_Change()
range("E1048576").Value = ComboBox2.Value
End Sub


Private Sub CommandButton1_Click()

'On Error GoTo errh
Dim myWB As Workbook, WB As Workbook
Set myWB = thisworkbook

batch = range("D1048576").Value
dat = range("C1048576").Value
bln = Month(dat)
range("C1048574").Value = Left(MonthName(bln), 3)
range("C1048573").Value = Day(dat)
range("C1048575").Value = Year(dat)

tgl = range("C1048573").Value
bln = range("C1048574").Value
prod = range("E1048576").Value

Sheets("control").Select

path = "C:\Heru\XML\XML 27-29 MEI\" & tgl & " " & bln & "\" & prod & "\"

Dim myPath

myPath = path '\28 MEI\PL\<<< change path
Dim myFile
myFile = Dir(myPath & "*.xml")
Dim t As Long
t = 1
Application.ScreenUpdating = False
Do While myFile <> ""
Set WB = Workbooks.OpenXML(filename:=myPath & myFile)
WB.Sheets(1).UsedRange.Copy myWB.Sheets(1).Cells(t, "A")
WB.Close True
't = myWB.Sheets(1).UsedRange.Rows.Count + 2
myFile = Dir()
Loop

'EXPORT=======================
With Sheets("Output1")
.range("A:IV").Select
End With

Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs filename:="C:\Heru\Project\OutXML\Hasil.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'=======================

Application.ScreenUpdating = True

'errh:
'MsgBox "XML Files not found"
myWB.Save



Exit Sub

End Sub

Private Sub CommandButton2_Click()
Sheets("Output1").Select
range("A:AJ").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs filename:="C:\Heru\Project\OutXML\Hasil.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Sub hapus()
Sheets("Output1").Value
End Sub


Mohon bantuannya mastah emoticon-Blue Guy Cendol (L) emoticon-Blue Guy Cendol (L) emoticon-Blue Guy Cendol (L) emoticon-Blue Guy Cendol (L)