Code:
Public Sub DATA_noibang()Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object
Set cn = CreateObject("adodb.connection")
Set fso = CreateObject("Scripting.FileSystemObject")
Sheets("noibang").AutoFilterMode = False
Sheets("noibang").Range("A1").CurrentRegion.Offset(1).ClearContents
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "G14", "*.xl*"
.InitialFileName = "*G14*.*"
.AllowMultiSelect = True
.Show
For i = 1 To .SelectedItems.Count
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,f2,f3,f4,f5,f6,f7,f8, from [G141$B19:I1000] ")
lr = Sheets("noibang").Range("A" & Rows.Count).End(3).Row
If Not rs.EOF Then Sheets("noibang").Range("A" & lr + 1).CopyFromRecordset rs
rs.Close
cn.Close
Next
End With
End Sub
How can i change code with:
a = sheets("main").range(D1).value ==> a = G141
b = sheet("main").range(E1).value ==> b = B19:I1000
c = sheets("main").range(F1).value ==> c = *G14*
Then code look like as red font:
Code:
Public Sub DATA_noibang()Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object
Set cn = CreateObject("adodb.connection")
Set fso = CreateObject("Scripting.FileSystemObject")
Sheets("noibang").AutoFilterMode = False
Sheets("noibang").Range("A1").CurrentRegion.Offset(1).ClearContents
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
[COLOR=#ff0000] .Filters.Add "c", "*.xl*"[/COLOR]
[COLOR=#ff0000] .InitialFileName = "c.*"[/COLOR]
.AllowMultiSelect = True
.Show
For i = 1 To .SelectedItems.Count
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,f2,f3,f4,f5,f6,f7,f8, [COLOR=#ff0000]from [a$b] ")[/COLOR]
lr = Sheets("noibang").Range("A" & Rows.Count).End(3).Row
If Not rs.EOF Then Sheets("noibang").Range("A" & lr + 1).CopyFromRecordset rs
rs.Close
cn.Close
Next
End With
End Sub
Thanks./.