(HELP) add multiple process to my code

[Ethen5155]

Hi all,

well, i just need some help or any hint to add one more function to below code


Sub ExtractData()

Set Destn = Range("A1")
For i = 100 To 600
With ActiveSheet.QueryTables.Add(Connection:="URL;http://basm.kacst.edu.sa/ViewTerm.aspx?termid=" & i, Destination:=Destn)
.Name = "Test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Set Destn = Destn.Offset(.ResultRange.Rows.Count)
End With
Next i

Workbooks("Extracted.xlsm").Close SaveChanges:=True

End Sub


i need it to get data from web with count from 100 to 600 for ex. then export it to xlsx file at a specific path folder, then add (500) to last number and continue work again with same work flow

for ex.

Get data from 100 to 600 --> Save --> Export to 1.xlsx to (C:/Test/Extracted)
+500 to last number
Get data from 600 to 1100 --> Save --> Export to 2.xlsx to (C:/Test/Extracted)
+500 to last number
Get data from 1100 to 1600--> Save --> Export to 3.xlsx to (C:/Test/Extracted)


i need this modification because i have to separate data on many files to ignore the big size for each file that can prevent opening them.

i hope it can be done

Thanks a lot

Cheers


Cross-Posting: http://www.excelforum.com/showthread.php?t=1172681&p=4576034#post4576034

[SamT]

Get data from 100 to 600 --> Save --> Export to 1.xlsx to (C:/Test/Extracted)
+500 to last number
Get data from 600 to 1100 --> Save --> Export to 2.xlsx to (C:/Test/Extracted)
+500 to last number
Get data from 1100 to 1600--> Save --> Export to 3.xlsx to (C:/Test/Extracted)

For i = 100 to 1100 Step 500
K = K + 1
For j = i to i + 499
With ActiveSheet. Etc
Blah Blah
End with
Next
Workbook (K & "Extracted.xlsx").Save etc
Next

[Ethen5155]

Dear Sam,

Thanks a lot for your help, it is highly appreciated

well i'm little confused, can please post the full code especially the full line to how export the file to specific path after saving it then reply the whole process again

sorry for bothering you again but i tried but didn't get it yet

Thanks in advance

[SamT]

Please provide that rest of the code in the Project. Also more details about the workbook the code is in and the book with the ActiveSheet

Is it required that each 500 records be in a separate book, OR can they all be in the same book, but on separate sheets?

[Ethen5155]

Hi Sam,

Thanks for your care and reply

well i just need to export every 500 records to separate book to a specific path like (C:\Extracted)

first 500 records with name (1.xlsx) on (C:\Extracted)
second 500 Records with name (2.xlsx) on (C:\Extracted)
.
.
.....etc

i hope you got what i mean and that is the original code


Sub ExtractData()

Set Destn = Range("A1")
For i = 100 To 600
With ActiveSheet.QueryTables.Add(Connection:="URL;http://basm.kacst.edu.sa/ViewTerm.aspx?termid=" & i, Destination:=Destn)
.Name = "Test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Set Destn = Destn.Offset(.ResultRange.Rows.Count)
End With
Next i



End Sub

[Ethen5155]

is it possible??

[JBeaucaire]

Maybe this:


Option Explicit
Sub ExtractData()
Dim i As Long, CNT As Long, f As Long, Highest As Long
Dim fPATH As String, Destn As Range
fPATH = "C:\Test\Extracted\" 'remember the final \ in this path string
Set Destn = Range("A1") 'starting point
f = 1 'first filename
Highest = 1600 'last number we will import from web

[Ethen5155]

Dear Jerry,

That was brilliant, works like magic

Thanks a lot bro you are the man :D :D

Cheers

Ethen