vba for word+loop until string get a value

[kalle82]

Hi!

I want to speed things up and im not that good at optimizing vba code since I'm a beginner.

The thing is that the code Im going to post below dont work everytime and it´s frustrating to click on the msgbox and run the code again. Is there a way to loop the function until the string gets a value or are there an even better way?

Sub getnavetinfo()

ProgressBar2.Value = 0
Dim strResult
Dim strResult2
Dim booUpper As Boolean

Dim numTDs
Dim C

Dim namnet
Dim namnet2
Dim startnamn
Dim slutnamn

Dim startstatus
Dim slutstatus
Dim status

Dim mellannamnet
Dim mellannamnet2
Dim startmellannamn
Dim slutmellanamn

Dim efternamnet
Dim startefternamn
Dim slutefternamn

Dim adressen
Dim adressen2
Dim startadress
Dim slutadress

Dim sarskilda
Dim sarskilda2
Dim startsarskilda
Dim slutsarskilda

Dim fastigheten
Dim startfastighet
Dim slutfastighet
ProgressBar2.Value = 5
Dim ie As Object
Set ie = CreateObject("internetexplorer.application")

ie.Visible = False

ie.Navigate "[URL unfurl="true"]https://una5pkg.rsv.se/na/na_personsok/personsok.do?idPersSelect="[/URL] & TextBox3.Value
ProgressBar2.Value = 20

If OptionButton4.Value = True Then

Sleep 500
hamtningsfart = "Supersnabbt"
ElseIf OptionButton5.Value = True Then

Sleep 1000
hamtningsfart = "Snabbt"
ElseIf OptionButton6.Value = True Then

Sleep 2000
hamtningsfart = "Lagom"
ElseIf OptionButton7.Value = True Then

Sleep 3000
hamtningsfart = "Långsamt"
End If

'start = 0
' StopTime = 20000000
'  While start < StopTime
'       start = start + 1
'    Wend

'numTDs = ie.Document.getElementsByTagName("td").Length
On Error GoTo 1

C = ie.Document.Body.innerHTML

ProgressBar2.Value = 70

' Förnamnet
startnamn = InStr(1, C, "rnamn:") + 28

slutnamn = InStr(1, C, "Mellannamn:") - 37
   
namnet = Mid(C, startnamn, slutnamn - startnamn + 1)

TextBox18.Value = namnet
ProgressBar2.Value = 75
'mellannamnet
startmellannamn = InStr(1, C, "Mellannamn:") + 33

slutmellannamn = InStr(1, C, "Efternamn:") - 37
    
mellannamnet = Mid(C, startmellannamn, slutmellannamn - startmellannamn + 1)

If mellannamnet = "  " Then

mellannamnet2 = Replace(mellannamnet, " ", "Har inget mellannamn!")

Else

mellannamnet2 = mellannamnet

End If
ProgressBar2.Value = 80
'Efternamnet
startefternamn = InStr(1, C, "Efternamn:") + 32
 
slutefternamn = InStr(1, C, "Aviseringsnamn:") - 37

efternamnet = Mid(C, startefternamn, slutefternamn - startefternamn + 1)
ProgressBar2.Value = 85

startstatus = InStr(1, C, "nvisningspersonnr:") + 156
slutstatus = InStr(1, C, "Datum:") - 38
status = Mid(C, startstatus, slutstatus - startstatus + 1)

If Len(status) >= 75 Then
status = "Personen är utvandrad"
End If


'Fastigheten
startfastighet = InStr(1, C, "Fastighet:") + 32

slutfastighet = InStr(1, C, "ringsadress:") - 100

fastigheten = Mid(C, startfastighet, slutfastighet - startfastighet + 1)

fastigheten = StrConv(fastigheten, vbProperCase)

'Folkbokföringsadress
startadress = InStr(1, C, "ringsadress:") + 34

slutadress = InStr(1, C, "rskild postadress") - 92

adressen = Mid(C, startadress, slutadress - startadress + 1)
   
adressen2 = Mid(C, startadress, slutadress - startadress + 1)
   
  
If adressen = "  " Then

TextBox5.Value = "Har ingen folkbokföringsadress!"
TextBox25.Value = "Har ingen folkbokföringsadress!"

ElseIf fastigheten = "Utan Känt Hemvist" Then

TextBox5.Value = "Utan känt hemvist"
TextBox25.Value = "Utan känt hemvist"

ElseIf fastigheten = "På Församlingen Skrivna" Then

TextBox5.Value = "På församlingen skrivna"
TextBox25.Value = "På församlingen skrivna"

Else

adressen = Replace(adressen, "<BR>", vbNewLine)
  
adressen = StrConv(adressen, vbProperCase)

adressen2 = Replace(adressen2, "<BR>", " ")

TextBox5.Value = adressen
TextBox25.Value = adressen2
End If


ProgressBar2.Value = 90
'Särskild postadress
startsarskild = InStr(1, C, "rskild postadress") + 40
slutsarskild = InStr(1, C, "Civilst") - 264

sarskilda = Mid(C, startsarskild, slutsarskild - startsarskild + 1)
sarskilda2 = Mid(C, startsarskild, slutsarskild - startsarskild + 1)
If sarskilda = "  " Then

TextBox23.Value = "Har ingen särskild postadress!"
TextBox31.Value = "Har ingen särskild postadress!"

ElseIf Len(sarskilda) >= 80 Then

TextBox23.Value = "Har ingen särskild postadress!"
TextBox31.Value = "Har ingen särskild postadress!"

Else

sarskilda = Replace(sarskilda, "<BR>", vbNewLine)
   
sarskilda = StrConv(sarskilda, vbProperCase)

sarskilda2 = Replace(sarskilda2, "<BR>", " ")

TextBox23.Value = sarskilda
TextBox31.Value = sarskilda2

End If
ProgressBar2.Value = 95


TextBox20.Value = fastigheten

TextBox32.Value = status

TextBox22.Value = mellannamnet2

TextBox19.Value = efternamnet

1

If C = "" Then

MsgBox "Din dator klarar inte av att hämta information med hastigheten: " & hamtningsfart, , "Du har valt för snabb hämtning av information!"


End If

ie.Quit

Set ie = Nothing
ProgressBar2.Value = 100

End Sub

 

[Foundy]

Hi Kalle,

I have just had a quick look through your code and I would suggest looking into Do While Loops a basic example is:

Do while YourString <> "aValue"
  YourString = "aValue"
Loop

This would keep the macro running till it found a value. Beware though if it never finds an error it will keep looping.

I would also look into Select Case statment this would help in reducing your nested If statements which would speed things up.

Hope this is of some help.

 

[kalle82]

Hi!

Thanks for the answer

The real problem is when

C = ie.Document.Body.innerHTML has an empty value.

The program crashes, Therefore i built in the on error telling them they must do it again.

Is there anyway i can loop the funtctiion until
C = ie.Document.Body.innerHTML gets a value?

 

[PHV]

...
ie.Navigate "

https://una5pkg.rsv.se/na/na_personsok/personsok.do?idPersSelect="

& TextBox3.Value
Do While ie.ReadyState <> 4
DoEvents
Loop
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kalle82]

Wow thanks alot works like a charm!

 

[Andrzejek]

You declare a lot of variables, but only 2 of them have a specified Type - one Boolean, and one Object. The rest of them are Variants but you use most of them As Strings. I would suggest to declare them with the Type.

Dim strResult [blue]As String[/blue]
Dim strResult2 [blue]As String[/blue]
Dim booUpper As Boolean
...

Have fun.

---- Andy