Add data from many files (they are in same format)

[keemain2]

my code is:

 Sub Macro2()
' Macro2 Macro
' 宏由 MS User 录制，时间: 2007-3-9
With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;file:///G:/a326/ICStock(1).asp", Destination:=Range("A1"))
    .Name = "ICStock(1)"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "16"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
End Sub

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

i want to change these code: file:///G:/a326/ICStock(1).asp .


because i have files from ICStock(1).asp to ICStock(1000).asp .


i need to select them at once when i adding datas.

[moa]

Not sure if this is what you want...

Sub Macro2()
Dim X as Long
For X = 1 To 1000
    With ActiveSheet.QueryTables.Add(Connection:= _
    "FINDER;file:///G:/a326/ICStock(" & CStr(X) & ").asp", destination:=range("A1"))
        .Name = "ICStock(" & CStr(X) & ")"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "16"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Next
End Sub

[moa]

Is it necessary to set all of those properties? Did you record a Macro to get this code?

[keemain2]

Thanks Glen .

i get these code from recording a Macro.

here is my question again:

according to your code replied to me,
how to set the Range? it is changing from A1，A60，A119，A178……A29442.

Sub Macro2() 
Dim X As Long 
 
For X = 1 To 1000 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
    "FINDER;file:///G:/a326/ICStock(" & CStr(X) & ").asp", destination:=range("A1")) 
        .Name = "ICStock(" & CStr(X) & ")" 
        .FieldNames = True 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .BackgroundQuery = True 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = True 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .WebSelectionType = xlSpecifiedTables 
        .WebFormatting = xlWebFormattingNone 
        .WebTables = "16" 
        .WebPreFormattedTextToColumns = True 
        .WebConsecutiveDelimitersAsOne = True 
        .WebSingleBlockTextImport = False 
        .WebDisableDateRecognition = False 
        .WebDisableRedirections = False 
        .Refresh BackgroundQuery:=False 
    End With 
Next 
End Sub 

James

[keemain2]

according to Glen's code.

i solved my problem by myself:

here is the code:

Sub add_data_hqew6()
' add_data_hqew6 Macro
' 宏由 MS User 录制，时间: 2007-3-9
' 快捷键: Ctrl+m
Dim X, y As Long
y = -58
    For X = 1 To 1000 '这里设置文件:个数,下面第 3 行修改文件夹位置
    y = y + 59
        With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;file:///G:/a326/ICStock(" & CStr(X) & ").asp", Destination:=Range("A" & CStr(y) & ""))
            .Name = "ICStock(" & CStr(X) & ")"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "16"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
    End With
Next
End Sub

Thanks Glen again.

Without your helping, i could not make it.


thanks VBA Express Forum.

thanks.



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

James from Shenzhen, China.
March 10th , 2007

[moa]

Well done James.

For future reference, you should make sure you dimension your variables separately:

Dim X as Long
Dim Y as Long

X is not set as Long in your code. It defaults to variant if not explicitly set

try this to test:

Dim X as Long
Dim Y as Long
msgbox "X = " & typeName(X) & vbnewline & "Y = " & typeName(Y)
Dim X, Y as Long
msgbox "X = " & typeName(X) & vbnewline & "Y = " & typeName(Y)

The first message box should tell you that X is Long while the second should say that it is "empty".

Also you don't need the empty string here:

"FINDER;file:///G:/a326/ICStock(" & CStr(X) & ").asp", Destination:=Range("A" & CStr(y) & ""))

Can be:

"FINDER;file:///G:/a326/ICStock(" & CStr(X) & ").asp", Destination:=Range("A" & CStr(y)))

[keemain2]

ths Glen.

I understand your code completely now.

ths for helping.




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

James march 15th, 2007

[moa]

That's great. You can mark this thread as solved using Thread Tools.