/ Forside/ Teknologi / Administrative / MS-Office / Spørgsmål
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
MS-Office
#NavnPoint
sion 18709
refi 14474
Klaudi 9389
Rosco40 5695
berpox 5456
dk 5398
webnoob 4919
Benjamin... 4870
o.v.n. 4637
10  EXTERMINA.. 4373
Excel henter krak oplysning via makro
Fra : fjernsyn01
Vist : 1620 gange
20 point
Dato : 16-11-11 19:12

Hej jeg har brug for hjælp i forbindelse med excel.
Jeg har søgt over nettet og faktisk fundet en makro som man burde kunne bruge til at hente krak oplysninger ned i en Excel regneark blot ved at taste telefonnr i A1.
Desværre får jeg en fejlmeddelelse hver gang jeg bruger det.

Er der et geni som kan forklare mig hvad det er som jeg skal ændre på denne makro. Markere hvad der ser ud til at være fejl i med . Først beskriver jeg teksten som går i fejl og under den makro jeg har indsat. I har reddet mig flere måneders kamp hvis det er.

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.krak.dk/ (...) & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
, Destination:=Range("A1"))

Selve makroen som jeg har indsat i excel er:

Sub Makro()

Nr = Selection
Fuldadresse = Selection.Address
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.krak.dk/ (...) & Nr & "&WhoOnlySearch=false&ExtendSearch=false" _
, Destination:=Range("A1"))
.Name = _
"Kort.aspx?Who=" & Nr & "&WhoOnlySearch=false&ExtendSearch=false"
.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
End With
Navn = Range("A24").Value
Adresse = Range("A25").Value
PostNrBy = Range("A26").Value
PostNrBy = Split(PostNrBy, " ", 2)


Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

Range(Fuldadresse).Offset(0, 1).Select
Range(Fuldadresse).Offset(0, 1).Value = Navn
Range(Fuldadresse).Offset(0, 2).Value = Adresse
Range(Fuldadresse).Offset(0, 3).Value = PostNrBy(0)
Range(Fuldadresse).Offset(0, 4).Value = PostNrBy(1)

End Sub

 
 
Kommentar
Fra : Brassovitski


Dato : 16-11-11 20:22

Hmmmmm!
Hvorfor er det lige at du opretter det samme spørgsmål 3 gange og så annullerer det kort efter???????????????????????????????? Stammer du eller???????????????????????????????????


Kommentar
Fra : sion


Dato : 16-11-11 20:45

Du har fundet løsningen hos Eksperten.dk her: http://www.eksperten.dk/spm/816032

Der er flere problemer med din kode:

1) Din URL "URL;http://www.krak.dk/ (...) & Nr & "&WhoOnlySearch=false&ExtendSearch=false" er direkte kopieret fra det oprindelige spørgsmål hos Eksperten.dk, og du får dermed ikke det med, som gemmer sig bag (...) - hvis du holder musen over i det oprindelige spørgsmål, kan du se, at det dækker over http://www.krak.dk/Person/Resultat.aspx?Who=". Din kode skal derfor rettes, så URL'en er korrekt.

2) Krak benytter ikke de URLs længere, som de gjorde, da spørgsmålet blev stillet på Eksperten.dk i 2008.

Jeg kan muligvis lave noget, der virker med Kraks nye system, men jeg ved ikke lige, om jeg får tid til det.

Simon

Kommentar
Fra : fjernsyn01


Dato : 16-11-11 22:49

Hej Brassovitski undskylder men troede jeg kunne indsætte html herinde men gik ikke så godt. Kan ikke finde ud af hvordan at man går ind og ændre et indlæg så prøvede at slette den igen. Lavede så en fejl mere i nr 2 så det tog desværre 3 gange

Sion okay tusind tak. At jeg skal bruge makro er ikke fordi jeg er en ekspert som du nok har kunnet se . Første gang jeg prøver det men lyder som den bedste mulighed til dette formål . Jeg har kæmpet med det så længe så hvis du en gang får tid til det vil det være helt fantastisk. Vil kunne hjælpe mig med at gøre en bøvlet proces meget hurtig i forhold til i dag.

Mvh Michael

Accepteret svar
Fra : CiviC

Modtaget 20 point
Dato : 19-11-11 03:34

Jeg har selv brugt det nogle gange, men krak laver om i tingene en gang imellem, så jeg ved ikke hvor længe den holder. Denne virker på privat-personer, så hvis du skal søge på firmaer, skal der nok ændres/tilføjes noget

Indtast tlf nr (Eks. 88888888) i A1 og kør denne makro:

Sub Makro1()
On Error GoTo Næste2
Tlf_Nr = Mid(Range("A1"), 1, 2) & " " & Mid(Range("A1"), 3, 2) & " " & Mid(Range("A1"), 5, 2) & " " & Mid(Range("A1"), 7, 2)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.krak.dk/person/resultat/" & Range("A1"), Destination:=Range("$A$1") _
)
.Name = Range("A1")
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
'.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False '----
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Navn = Range("A15")
If Mid(Range("A18"), 1, 3) = "Tel" Then
Tlf_Nr2 = Mid(Range("A17"), 27, 12)
Tlf_Nr = Mid(Range("A18"), 5, 11)
Start = 17
Else
Start = 1
End If
For x = Start To Len(Range("A18"))
If Mid(Range("A18"), x, 1) = " " Then
For y = x + 1 To Len(Range("A18"))
If Mid(Range("A18"), y, 1) = " " Then
For Z = y + 1 To Len(Range("A18"))
If Mid(Range("A18"), Z, 1) = " " Then
For q = Z + 1 To Len(Range("A18"))
If Mid(Range("A18"), q, 1) = "." Then
q = q - 3
GoTo Næste
End If
Next
End If
Next
End If
Next
End If
Next

Næste:

Vej = Mid(Range("A18"), Start, (y - Start))
By = Mid(Range("A18"), y + 1, ((q - 1) - y))


Rows("1:60").Delete

Range("A1") = Navn
Range("A2") = Vej
Range("A3") = By
Range("A4") = Tlf_Nr
Range("A5") = Tlf_Nr2
Range("A1:A5").Select
Columns("A:A").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlLeft
End With
Range("A1").Select
Exit Sub
Næste2:
Rows("1:600").Delete
Range("A1").Select
MsgBox ("Der er desværre en fejl med det indtastede nr. Prøv igen")

End Sub

Kommentar
Fra : CiviC


Dato : 19-11-11 03:42

Testede lige lidt.
Umiddelbart virker den sålænge, der kun er et resultat på nummeret.

Godkendelse af svar
Fra : fjernsyn01


Dato : 19-11-11 14:59

Tak for svaret CiviC. Rent verdensklasse du har reddet min dag . Håber der går lang tid inden de ændre det så jeg ikke kan bruge denne Makro. Tusind tak.

Har et tillægsspørgsmål som er mere med makro generelt tror jeg. Nu kan jeg taste noget ind i A1 vil det være muligt at kunne taste noget ind i B1 så den vil lave det samme. Jeg skal vel bare ændre på de forskellige A i din makroen, eller findes der en genvej i excel til at gøre det hurtigere. Har tænkt mig at lave ca 10 muligheder.

Hvor er det lækkert tak endnu en gang. Hej hej

Michael

Kommentar
Fra : CiviC


Dato : 20-11-11 01:23

Hejsa

Prøv denne: http://dl.dropbox.com/u/19067770/Mappe3.xlsm

Den finder info om alle de numre du taster (én ad gangen) indtil du lader feltet stå tomt eller trykker "Cancel"


Mvh
CiViC

Kommentar
Fra : fjernsyn01


Dato : 20-11-11 01:43

CiViC

Ved du hvad jeg bukker dybt i støvet. Hvor er det vildt. Det er simpelten verdensklasse kan ikke være mere optimalt.

Håber jeg kan hjælpe dig på et senere tidspunkt, tusind tak.

Mvh Michael

Kommentar
Fra : CiviC


Dato : 20-11-11 01:53

Det var så lidt.
Den har et par småfejl, men det kan du måske rette op på
Det er primært, hvis der kun er ét fast nr og ingen mobilnumre.

Mvh
CiViC

Du har følgende muligheder
Eftersom du ikke er logget ind i systemet, kan du ikke skrive et indlæg til dette spørgsmål.

Hvis du ikke allerede er registreret, kan du gratis blive medlem, ved at trykke på "Bliv medlem" ude i menuen.
Søg
Reklame
Statistik
Spørgsmål : 177549
Tips : 31968
Nyheder : 719565
Indlæg : 6408820
Brugere : 218887

Månedens bedste
Årets bedste
Sidste års bedste