UltraVolta425
New Member
- Joined
- Jul 10, 2015
- Messages
- 1
Hey, I'm using Excel 2010.
I'm from Belgium (the following code will probably reflect that).
In our country, like anywhere else, there's trains, lots of them. And there's a website that checks the arrivals and departure times of trains in a station of your choice.
Now, what my Excel workbook does, is it goes to the NMBS website (the website I mentioned above), fills in the necessary departure time, departure station and arrival station (which it gets from a tab called "NMBS"), and then presses a button on the website to have it calculate for you, which train to take.
Then, my excel workbook takes all that information and copies it back to excel, in another worksheet.
The following code does what I just described:
Sorry for the dutch comments, btw.
Now, the problem: If you review the code, you'll see that I have two messageboxes, the first: "Eerste trein gevonden" and the second: "Tweede trein gevonden".
These messageboxes are very annoying, but somehow without them, I have experienced that the code simply doesn't work.
Could you guys edit the code a little for me so that I won't need those msgboxes anymore?
I'm from Belgium (the following code will probably reflect that).
In our country, like anywhere else, there's trains, lots of them. And there's a website that checks the arrivals and departure times of trains in a station of your choice.
Now, what my Excel workbook does, is it goes to the NMBS website (the website I mentioned above), fills in the necessary departure time, departure station and arrival station (which it gets from a tab called "NMBS"), and then presses a button on the website to have it calculate for you, which train to take.
Then, my excel workbook takes all that information and copies it back to excel, in another worksheet.
The following code does what I just described:
Code:
Sub NMBS()
'DEZE FUNCTIONALITEIT ZAL WEERGEVEN WELKE TREIN U MOET PAKKEN
'EERST DECLAREREN WE ENKELE VARIABELEN
Dim ie As Object
Dim IEdoc2 As Object
Dim Tijd As Range
Dim TijdValue As String
Dim TijdNMBS As String
Dim VeldTijd As Object
Dim Vertrek As Range
Dim VertrekValue As String
Dim VeldVan As Object
Dim Arrival As Range
Dim ArrivalValue As String
Dim VeldNaar As Object
Dim EnkelTreinen As Object
Dim EnkelTreinenVeld As Range
Dim EersteBevestiging As Object
Dim TweedeBevestiging As Object
Dim TreinValue As Object
Dim Clip As DataObject
Dim sheetDest As Worksheet
Dim Details1 As Object
Dim Details2 As Object
Dim sheetDest2 As Worksheet
Dim TreinValue2 As Object
Dim FindString As String
Dim Rng As Range
Dim Rng3 As Range
Dim Rng5 As Range
Dim FindStringOverstappen As String
'NMBS IS EEN TRAGE WEBSITE. INGEVAL HIJ TÉ TRAAG IS, RESULTEERT DAT IN EEN EXCEL DEBUG-ERROR. OM DAT TE VERMIJDEN:
On Error GoTo InvalidValue:
'EERST MOETEN WE DE JUISTE DATA HEBBEN OM EEN OPZOEKING TE DOEN
'BEGINNEN MET EEN GEWENST TIJDSTIP
Set Tijd = ThisWorkbook.Sheets("NMBS").Range("D12")
TijdValue = Tijd.Value
TijdNMBS = Left(TijdValue, 2) & ":" & Right(TijdValue, 2)
'DAN DOEN WE HET VERTREKADRES
Set Vertrek = ThisWorkbook.Sheets("NMBS").Range("D8")
VertrekValue = Vertrek.Value
'DAN DOEN WE HET ARRIVALADRES
Set Arrival = ThisWorkbook.Sheets("NMBS").Range("D10")
ArrivalValue = Arrival.Value
'NU HEBBEN WE ALLE NODIGE DATA, NU GAAN WE NAAR DE WEBSITE VAN DE NMBS
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
URL = "http://www.belgianrail.be/jp/sncb-nmbs-routeplanner/query.exe/nl?HWAI=VIEW!advanced=yes!&"
ie.Navigate URL
'DAN WACHTEN WE EFKES TOT DE WEBSITE EFFECTIEF GELADEN IS
Application.Wait (Now + #12:00:05 AM#)
'DAN VULLEN WE ALLE JUISTE DATA IN
Set IEdoc2 = ie.Document
Set VeldVan = IEdoc2.getElementByID("HFS_from")
VeldVan.Value = VertrekValue
Set VeldNaar = IEdoc2.getElementByID("HFS_to")
VeldNaar.Value = ArrivalValue
Set VeldTijd = IEdoc2.getElementByID("HFS_time_REQ0")
VeldTijd.Value = TijdNMBS
'DAN KIJKEN WE NA OF DE GEBRUIKER ENKEL TREINEN WENST, OF OOK BUSSEN
Set EnkelTreinenVeld = ThisWorkbook.Sheets("NMBS").Range("D14")
If EnkelTreinenVeld.Value = "Ja" Or EnkelTreinenVeld.Value = "ja" Or EnkelTreinenVeld.Value = "JA" Then
Set EnkelTreinen = IEdoc2.getElementByID("HFS_products_1")
EnkelTreinen.Click
ElseIf EnkelTreinenVeld.Value = "Nee" Or EnkelTreinenVeld.Value = "nee" Or EnkelTreinenVeld.Value = "NEE" Then
Set EnkelTreinen = IEdoc2.getElementByID("HFS_products_3")
EnkelTreinen.Click
Else
MsgBox ("Gelieve het veld 'Enkel treinen?' in te vullen met 'ja' of 'nee'")
End If
'DAN WACHTEN WE EFKES TOT DE WEBSITE EFFECTIEF GELADEN IS
Application.Wait (Now + #12:00:02 AM#)
'DAN KLIKKEN WE OP VERSTUREN
Set EersteBevestiging = IEdoc2.getElementByID("start")
EersteBevestiging.Click
'DAN WACHTEN WE EFKES TOT DE WEBSITE EFFECTIEF GELADEN IS
Application.Wait (Now + #12:00:07 AM#)
'DAN KLIKKEN WE NOGMAALS OP VERSTUREN
Set TweedeBevestiging = IEdoc2.getElementsByName("Start")(0)
TweedeBevestiging.Click
'DAN WACHTEN WE EFKES TOT DE WEBSITE EFFECTIEF GELADEN IS
Application.Wait (Now + #12:00:07 AM#)
'DAN LEGGEN WE EERST VERDER NOG WAT VARIABELEN UIT
Set Details1 = IEdoc2.getElementByID("dtlTabC2-0")
Details1.Click
Set Details2 = IEdoc2.getElementByID("dtlTabC2-1")
Details2.Click
'DAN IST TIJD DAT WE DE JUSTEN TREIN OP ET JUSTE TABBLAD KRIJGEN
'VOLGENDE REGEL IS OM HET MACROPROCES TE VERSNELLEN
Application.ScreenUpdating = False
Set TreinValue = IEdoc2.getElementByID("updateC2-0")
Set sheetDest = ThisWorkbook.Sheets("TREIN1")
If Not TreinValue Is Nothing Then
AppActivate "Microsoft Excel"
MsgBox ("Eerste trein gevonden")
Set Clip = New DataObject
Clip.SetText "<html>" & TreinValue.outerHTML & "</html>"
Clip.PutInClipboard
sheetDest.Visible = True
sheetDest.Unprotect
sheetDest.Select
sheetDest.UsedRange.Clear
sheetDest.Pictures.Delete
'sheetDest.Cells.Clear
sheetDest.Range("A1").Select
sheetDest.Paste
sheetDest.Pictures.Delete
ActiveCell.Offset(2, 3).Select
sheetDest.Visible = False
End If
'DAN IST TIJD DAT WE DE JUSTEN TREIN OP ET JUSTE TABBLAD KRIJGEN
Set TreinValue2 = IEdoc2.getElementByID("updateC2-1")
Set sheetDest2 = ThisWorkbook.Sheets("TREIN2")
If Not TreinValue2 Is Nothing Then
MsgBox ("Tweede trein gevonden")
Set Clip = New DataObject
Clip.SetText "<html>" & TreinValue2.outerHTML & "</html>"
Clip.PutInClipboard
sheetDest2.Visible = True
sheetDest2.Unprotect
sheetDest2.Select
sheetDest2.UsedRange.Clear
sheetDest2.Pictures.Delete
'sheetDest2.Cells.Clear
sheetDest2.Range("A1").Select
sheetDest2.Paste 'Special "Unicode Text"
sheetDest2.Pictures.Delete
sheetDest2.Visible = False
End If
'DAN GAAN WE VOOR TAB TREIN1 ZORGEN DAT DE TE NEMEN TREIN ZICH VANBOVEN IN HET TABBLAD BEVINDT
Sheets("TREIN1").Activate
FindString = "Storingen"
If Trim(FindString) <> "" Then
With Sheets("TREIN1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
Range(ActiveCell.Offset(10, 0), ActiveCell.Offset(1, 10)).Select
Selection.Copy
sheetDest.Range("A1").PasteSpecial
'DAN GAAN WE VOOR TAB TREIN2 ZORGEN DAT DE TE NEMEN TREINEN ZICH VANBOVEN IN HET TABBLAD BEVINDEN
Sheets("TREIN2").Activate
FindString = "Storingen"
If Trim(FindString) <> "" Then
With Sheets("TREIN2").Range("A:A")
Set Rng3 = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng3 Is Nothing Then
Application.Goto Rng3, True
Else
MsgBox "Nothing found"
End If
End With
End If
Range(ActiveCell.Offset(10, 0), ActiveCell.Offset(1, 10)).Select
Selection.Copy
sheetDest2.Range("A1").PasteSpecial
'DAN GAAN WE VOOR TAB TREIN1 het aantal overstappen tellen
Sheets("TREIN1").Activate
FindStringOverstappen = "Je moet"
If Trim(FindString) <> "" Then
With Sheets("TREIN1").Range("A:A")
Set Rng5 = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng5 Is Nothing Then
Application.Goto Rng5, True
Else
MsgBox "Nothing found"
End If
End With
End If
Range(ActiveCell.Offset(10, 0), ActiveCell.Offset(1, 10)).Select
Selection.Copy
sheetDest2.Range("G1").PasteSpecial
'VOLGENDE REGEL IS OM HET MACROVERSNELLINGSPROCES AF TE SLUITEN
Application.ScreenUpdating = True
'DAN WACHTEN WE 3 SECONDEN OM EXCEL DE TIJD TE GEVEN OM ZIJN WERK GEDAAN TE KRIJGEN
Application.Wait (Now + #12:00:03 AM#)
'EN TENSLOTTE ZORGEN WE ERVOOR DAT DE INTERNET EXPLORERVENSTERS DIE HIERNET GEOPEND WERDEN, GESLOTEN WORDEN
ie.Quit
'DAN ZEGGEN WE WAT HIJ MOET DOEN IN GEVAL VAN ERRORS
Exit Sub
InvalidValue:
MsgBox ("De website van NMBS had (weer) eens een trageslakprobleem. Probeer opnieuw.")
End SubSorry for the dutch comments, btw.
Now, the problem: If you review the code, you'll see that I have two messageboxes, the first: "Eerste trein gevonden" and the second: "Tweede trein gevonden".
These messageboxes are very annoying, but somehow without them, I have experienced that the code simply doesn't work.
Could you guys edit the code a little for me so that I won't need those msgboxes anymore?
Last edited:
