Excel macro not retrieving data from website

bachi66

New Member
Joined
Apr 14, 2016
Messages
1
I am trying to retrieve data from following web site
KEGG COMPOUND: c00025
I used the following program

Sub abc()
Dim i As Integer
Dim myarray(248) As Single
Dim firstRow As Integer
Dim lastRow As Integer
Dim nextRow As Integer
Dim URLstart As String
Dim URLend As String
Dim shBook3 As Worksheet
Dim shQuery As Worksheet
Dim rgQuery As Range
Dim found As Range
Dim TimeOutWebQuery
Dim TimeOutTime
Dim objIE As Object
myarray(0) = C00025
myarray(1) = C00042
myarray(2) = C00074
myarray(3) = C00122
myarray(4) = C00147
myarray(5) = C00148
myarray(6) = C00168
myarray(7) = C00183
myarray(8) = C00186
myarray(9) = C00195
myarray(10) = C00246
myarray(11) = C00249
myarray(12) = C00296
myarray(13) = C00319
myarray(14) = C00328
myarray(15) = C00350
myarray(16) = C00350
myarray(17) = C00350
myarray(18) = C00350
myarray(19) = C00350
myarray(20) = C00350
myarray(21) = C00350
myarray(22) = C00350
myarray(23) = C00370
myarray(24) = C00388
myarray(25) = C00489
myarray(26) = C00555
myarray(27) = C00559
myarray(28) = C00571
myarray(29) = C00633
myarray(30) = C00673
myarray(31) = C00785
myarray(32) = C00881
myarray(33) = C00884
myarray(34) = C01014
myarray(35) = C01020
myarray(36) = C01040
myarray(37) = C01092
myarray(38) = C01092
myarray(39) = C01255
myarray(40) = C01485
myarray(41) = C01518
myarray(42) = C01530
myarray(43) = C01591
myarray(44) = C01674
myarray(45) = C01710
myarray(46) = C01740
myarray(47) = C01826
myarray(48) = C01933
myarray(49) = C01967
myarray(50) = C02008
myarray(51) = C02126
myarray(52) = C02214
myarray(53) = C02253
myarray(54) = C02253
myarray(55) = C02323
myarray(56) = C02378
myarray(57) = C02394
myarray(58) = C02632
myarray(59) = C02704
myarray(60) = C02862
myarray(61) = C02975
myarray(62) = C03092
myarray(63) = C03142
myarray(64) = C03219
myarray(65) = C03239
myarray(66) = C03264
myarray(67) = C03404
myarray(68) = C03590
myarray(69) = C03762
myarray(70) = C03804
myarray(71) = C03855
myarray(72) = C03855
myarray(73) = C03858
myarray(74) = C03864
myarray(75) = C03958
myarray(76) = C04146
myarray(77) = C04277
myarray(78) = C04592
myarray(79) = C04594
myarray(80) = C04834
myarray(81) = C05328
myarray(82) = C05607
myarray(83) = C05715
myarray(84) = C05799
myarray(85) = C06029
myarray(86) = C06066
myarray(87) = C06070
myarray(88) = C06184
myarray(89) = C06255
myarray(90) = C06381
myarray(91) = C06521
myarray(92) = C06661
myarray(93) = C06728
myarray(94) = C06771
myarray(95) = C06772
myarray(96) = C06833
myarray(97) = C06849
myarray(98) = C06866
myarray(99) = C06936
myarray(100) = C07056
myarray(101) = C07111
myarray(102) = C07158
myarray(103) = C07159
myarray(104) = C07182
myarray(105) = C07226
myarray(106) = C07227
myarray(107) = C07262
myarray(108) = C07287
myarray(109) = C07416
myarray(110) = C07432
myarray(111) = C07531
myarray(112) = C07601
myarray(113) = C07608
myarray(114) = C07655
myarray(115) = C07657
myarray(116) = C07875
myarray(117) = C07892
myarray(118) = C07934
myarray(119) = C07941
myarray(120) = C08152
myarray(121) = C08155
myarray(122) = C08262
myarray(123) = C08362
myarray(124) = C08362
myarray(125) = C08499
myarray(126) = C08509
myarray(127) = C08681
myarray(128) = C08735
myarray(129) = C09120
myarray(130) = C09558
myarray(131) = C09573
myarray(132) = C09579
myarray(133) = C09597
myarray(134) = C09653
myarray(135) = C09744
myarray(136) = C09878
myarray(137) = C09879
myarray(138) = C09989
myarray(139) = C10136
myarray(140) = C10155
myarray(141) = C10160
myarray(142) = C10163
myarray(143) = C10167
myarray(144) = C10270
myarray(145) = C10341
myarray(146) = C10342
myarray(147) = C10390
myarray(148) = C10438
myarray(149) = C10472
myarray(150) = C10497
myarray(151) = C10576
myarray(152) = C10868
myarray(153) = C10869
myarray(154) = C10921
myarray(155) = C10938
myarray(156) = C10947
myarray(157) = C11001
myarray(158) = C11079
myarray(159) = C11118
myarray(160) = C11124
myarray(161) = C11124
myarray(162) = C11166
myarray(163) = C11443
myarray(164) = C11519
myarray(165) = C11652
myarray(166) = C11721
myarray(167) = C11789
myarray(168) = C11844
myarray(169) = C11845
myarray(170) = C11903
myarray(171) = C11913
myarray(172) = C12027
myarray(173) = C12029
myarray(174) = C12150
myarray(175) = C12288
myarray(176) = C12295
myarray(177) = C12535
myarray(178) = C12859
myarray(179) = C12889
myarray(180) = C13061
myarray(181) = C13422
myarray(182) = C13709
myarray(183) = C13788
myarray(184) = C13791
myarray(185) = C13831
myarray(186) = C14043
myarray(187) = C14142
myarray(188) = C14153
myarray(189) = C14216
myarray(190) = C14235
myarray(191) = C14280
myarray(192) = C14291
myarray(193) = C14311
myarray(194) = C14439
myarray(195) = C14535
myarray(196) = C14577
myarray(197) = C14577
myarray(198) = C14686
myarray(199) = C14689
myarray(200) = C14757
myarray(201) = C14758
myarray(202) = C14947
myarray(203) = C15050
myarray(204) = C15053
myarray(205) = C15171
myarray(206) = C15281
myarray(207) = C15336
myarray(208) = C15346
myarray(209) = C15413
myarray(210) = C15623
myarray(211) = C15689
myarray(212) = C16201
myarray(213) = C16300
myarray(214) = C16320
myarray(215) = C16358
myarray(216) = C16462
myarray(217) = C16503
myarray(218) = C16648
myarray(219) = C16658
myarray(220) = C16825
myarray(221) = C16977
myarray(222) = C17214
myarray(223) = C17227
myarray(224) = C17391
myarray(225) = C17996
myarray(226) = C18103
myarray(227) = C18103
myarray(228) = C18111
myarray(229) = C18312
myarray(230) = C18579
myarray(231) = C18671
myarray(232) = C18769
myarray(233) = C18795
myarray(234) = C18830
myarray(235) = C18912
myarray(236) = C18955
myarray(237) = C19109
myarray(238) = C19142
myarray(239) = C19325
myarray(240) = C19620
myarray(241) = C19621
myarray(242) = C19625
myarray(243) = C19681
myarray(244) = C19872
myarray(245) = D01272
myarray(246) = D01818
myarray(247) = D01954
myarray(248) = D06882
Application.ScreenUpdating = False
URLstart = "http://www.kegg.jp/dbget-bin/www_bget?cpd:"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Book3").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Book3"
Set shBook3 = Sheets("Book3")
For i = 0 To 248
Sheets.Add after:=Sheets(Sheets.Count)
Set shQuery = ActiveSheet
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate CStr(URLstart & myarray(i))
End With
TimeOutWebQuery = 10
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until objIE.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
objIE.stop
GoTo ErrorTimeOut
End If
Loop
objIE.ExecWB 17, 2
objIE.ExecWB 12, 2
shQuery.Range("A1").Select
shQuery.PasteSpecial NoHTMLFormatting:=True
objIE.Quit
Set objIE = Nothing
Set found = shQuery.Columns(1).Find("Name", , , xlWhole)
If Not found Is Nothing Then
firstRow = found.Row
If i > 1 Then firstRow = firstRow + 1
Else
GoTo FormatError
End If
Set found = shQuery.Columns(1).Find("Page ", found, , xlPart)
If Not found Is Nothing Then
lastRow = found.Row - 1
Else
GoTo FormatError
End If
Set rgQuery = shQuery.Rows(firstRow & ":" & lastRow)
nextRow = shBook3.Cells(Rows.Count, "A").End(xlUp).Row
If nextRow > 1 Then nextRow = nextRow + 1
rgQuery.Copy shBook3.Cells(nextRow, 1)
Application.DisplayAlerts = False
shQuery.Delete
Application.DisplayAlerts = True
Next i
shBook3.Columns.AutoFit
MsgBox "Query complete"
Exit Sub
FormatError:
MsgBox "Format Error"
Exit Sub
ErrorTimeOut:
objIE.Quit
Set objIE = Nothing
MsgBox "WebSite Error"
End Sub



It give following data
its not exact data
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Forum statistics

Threads
1,215,275
Messages
6,124,002
Members
449,137
Latest member
abdahsankhan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top