• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Download

Status
Niet open voor verdere reacties.

verluc

Gebruiker
Lid geworden
29 mei 2009
Berichten
535
Heb volgende macro in mijn programma:

Const URL = "http://www.stockwatch.com/Quote/Download.aspx?type=date&format=ascii&dest=file&exopt=N&ex=QTV&id=xxx&pw=xxxxxxxx"
ActiveWorkbook.SaveAs Filename:="C:\My Documents\data.txt"
ActiveWorkbook.FollowHyperlink URL

Eigenaardig dat ik steeds een foutmelding krijg (gele ban) op de laatste lijn : ActiveWorkbook.FollowHyperlink URL

Kan iemand een hint hierover geven ?
Met dank.
 
Je verteld niet welke melding je dan krijgt. Maar maak er eens dit van:
ActiveWorkbook.FollowHyperlink Address:=URL
 
Laatst bewerkt:
Zeer bedankt Edmoor, met deze kleine wijziging lukt het me.
Na afloop van deze downloading moet het bestand worden opgeslagen in data.txt
Dit lukt me ook, maar wanneer ik opslaan kies verandert data.txt steeds in data(1).txt of data(2).txt enz.
Kan dit niet telkens data.txt blijven en steeds overschrijving ?
 
Zo doet de download dat en kan je niks aan veranderen. Wat je wel kan doen is het bestand data.txt verwijderen voordat je gaat downloaden.
Dat kan dan weer met de Kill opdracht in VBA.
Code:
On Error Resume Next
Kill "C:\Users\verluc\Downloads\data.txt"
On Error Goto 0

Die On Error zorgt ervoor dat het ook werkt als het bestand niet aanwezig is.
 
Laatst bewerkt:
Sorry Edmoor, maar data.txt blijft zichzelf opnummeren.
Wanneer ik het scherm van downloads zie staat er inderdaad data.txt maar na het indrukken
Van de opslaan toets veranderd data.txt in bijvoorbeeld data(21).txt
Er staan slechts twee mogelijkheden op : openen of opslaan
Dus data.txt zou moeten blijven door te overschrijven.
 
Plaats je hele code eens en wat wil je hiermee bereiken?

Je slaat eerst het bestand op met de extensie .txt Dus het blijft een excelbestand maar dan met de extentie .txt? Vervolgens ga je een link openen waar je verder niets mee doet?

Je wil waarschijnlijk data via een webquery binnenhalen en dan de gegevens opslaan als tekstbestand?
 
Het pad dat ik gaf was uiteraard maar een voorbeeld. Heb je dat wel aangepast naar wat het moet zijn?
 
Dit is waar de foutmelding zich voordoet:

Code:
Workbooks.OpenText Filename[COLOR="#FF0000"]:="C:\Users\Luc\Downloads\data.txt", [/COLOR]Origin _
         :=xlWindows, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon _
        :=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 2), _
        Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2))

Melding : kan dit bestand niet vinden
 
Bij downloaden heb ik deze code gebruikt:

Code:
On Error Resume Next
Kill "C:\Users\luc\Downloads\data.txt"
On Error GoTo 0
Const URL = "http://www.stockwatch.com/Quote/Download.aspx?type=date&format=ascii&dest=file&exopt=N&ex=QTV&id=H&pw=32789573"
ActiveWorkbook.SaveAs Filename:="C:\Users\Luc\Downloads\data.txt"
ActiveWorkbook.FollowHyperlink URL

Bij het verwerken van deze download :

Code:
Workbooks.OpenText Filename[COLOR="#FF0000"]:="C:\Users\Luc\Downloads\data.txt", [/COLOR]Origin _
         :=xlWindows, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon _
        :=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 2), _
        Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2))

Dit is toch dezelfde oproeping als bij downloaden ?
 
Laatst bewerkt:
Feit is dat als er wordt doorgenummerd het bestand al bestaat. Daarnaast verwijder je met de kill opdracht het bestand en zet je er direct weer een bestand neer met dezelfde naam.

Waarom sla je je document op dezelfde plek als waar de download een bestand met dezelfde naam neer zet?
Nogal logisch dat 'ie dan doornummert. Het bestand bestaat immers weer.
 
Laatst bewerkt:
Heb deze weggehaald.
Koersen worden wel gedownload,doch wanneer ik data.txt kies om op te slaan word er automatisch een nummer toegevoegd
en kan deze dus niet meer oproepen via mijn code.
 
Laat dan eens zien wat je nu hebt.
 
Kan niets laten zien om reden dat het programma het niet doet.
Download de koersen in data.txt (platte tekst - asci) en wil deze dan omzetten naar een excelblad.
 
Met een voorbeeld bestandje wordt je sneller en beter geholpen, maar zonder dat wij de id en pw krijgen, zul jij toch de laatste stap naar de oplossing moeten zetten.

Een excel web query kan ook rechtstreeks een text-bestand van het web halen, zie https://msdn.microsoft.com/en-us/library/office/ff837414.aspx en https://msdn.microsoft.com/en-us/library/office/ff837414.aspx en http://stackoverflow.com/questions/21241197/excel-vba-querytables-text-vs-url-connections door het vervangen van "URL door "TEXT" in de connection.
 
Laatst bewerkt:
Je kan toch eenvoudig laten zien welke code je nu hebt?
 
Dit is mijn huidige code voor het omzetten van data.txt naar excelwerkblad .Krijg foutmelding 1004 bij rode tekst:

Code:
Sub Beursgegevens_verwerken()
   ' bestand = ActiveWorkbook.Name
     Sheets("Portefeuille (10)").Select
    Dim LR As Integer
LR = Range("A" & Rows.Count).End(xlUp).Row
Union(Range("F3:F" & LR), _
Range("H3:H" & LR), _
Range("I3:I" & LR), _
Range("J3:J" & LR), _
Range("K3:K" & LR), _
Range("M3:M" & LR), _
Range("N3:N" & LR), _
Range("T3:T" & LR), _
Range("U3:U" & LR), _
Range("V3:V" & LR), _
Range("W3:W" & LR)).FillDown
Range("A4:S1000").Cells.Interior.ColorIndex = xlNone
 With ActiveSheet.Range("A4:E1000,J4:K1000").Font
        .Name = "Verdana"
        .Size = 10
        .FontStyle = "vet"
        .ColorIndex = 0
    End With
    With ActiveSheet.Range("H4:I1000").Font
        .Name = "Verdana"
        .Size = 10
        .FontStyle = "vet"
        .ColorIndex = 14
    End With
    With ActiveSheet.Range("F4:F1000,M4:N1000").Font
        .Name = "Verdana"
        .Size = 10
        .FontStyle = "vet"
        .ColorIndex = 5
        End With
    Range("X1").ClearContents
    Range("X1") = Range("J2")
    Dim LastRow As Long, r As Long
  Const FirstRow As Long = 4
  LastRow = Range("F" & Rows.Count).End(xlUp).Row
  For r = FirstRow To LastRow
    If Range("F" & r).Text <> "#N/B" Then
       Range("G" & r).Value = Range("F" & r)
    End If
  Next r
    'Call Copy_Cells
    Sheets("Beurskoersen").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
   [COLOR="#B22222"] Workbooks.OpenText Filename:="C:\Users\Luc\Downloads\data.txt", Origin _
         :=xlWindows, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon _
        :=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 2), _
        Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2))[/COLOR]    
Cells.Replace What:=".", Replacement:=",", Lookat:=xlPart, _
        Searchorder:=xlByRows, MatchCase:= _
        False
    Cells.Select
    Selection.NumberFormat = "#,##0.00#"
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:= _
        xlTopToBottom
    Range("A1:I14000").Select
    Selection.Copy
    Windows(bestand).Activate
    ActiveWindow.WindowState = xlNormal
    Sheets("Beurskoersen").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Windows("data.txt").Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
    'Application.StatusBar = ""
    Sheets("Portefeuille (10)").Select
    Call Copy_Cells
    'ActiveWorkbook.Save
    'Range("J1") = Range("J2") - Range("X1")
    MsgBox "Gegevens zijn verwerkt en aangepast, ! !", vbExclamination, " Bewerken"
End Sub
 
Die foutmelding krijg je als het bestand C:\Users\Luc\Downloads\data.txt niet bestaat.
 
Dat is juist het probleem: data.txt kan niet bestaan omdat deze automatisch veranderd in data(1).txt na het opslaan ervan.
 
En daarvan heb ik gezegd wat je eraan moet doen. Wat je plaatste is trouwens niet de code waar je die download doet en daar ging het me om. Dit dus:
Code:
On Error Resume Next
Kill "C:\Users\luc\Downloads\data.txt"
On Error GoTo 0
URL = "http://www.stockwatch.com/Quote/Download.aspx?type=date&format=ascii&dest=file&exopt=N&ex=QTV&id=H&pw=32789573"
ActiveWorkbook.FollowHyperlink URL

Als die download een bestand met de naam data.txt in de map C:\Users\luc\Downloads plaatst zal dat gewoon goed gaan.
Het is trouwens niet nodig om van de variabele URL een Const te maken.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan