28. februar 2014 - 21:12Der er
18 kommentarer og 1 løsning
vba Loop / Sti problem.
Hej eksperter!
Sidder og roder med lidt loop og sti. Første del virker, men kunne godt tænke mig evt. loop ind i det, da jeg ellers skal sidde og kode stxt op til 99 gange. Den sidste del, som går hen til error hvis den første ikke kan finde filen. der får jeg fejl med at den siger dårlig fil eller dårlig nummer. Men den indsætter den første ligne fra txt filen til Excel arket men bare ikke resten.
formatet i txt filen er: test. test1. test2. osv.
Her er koden som jeg har pt.
Sub Read() Dim myPath As String myPath = ActiveWorkbook.Path Dim fnavn As String Dim strPath As String Dim strFileName As String On Error GoTo error
'Udskift stien med den ønskede sti If Len(Dir(myPath & "\Update\", vbDirectory)) = 0 Then MkDir myPath & "\Update\" End If strPath = myPath & "\Update\"
Application.DisplayAlerts = False ChDir (strPath) Dim sFile As String Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, _ sText7 As String, sText8 As String, sText10 As String Dim iFilenum As Integer
sFile = strPath & "Test.txt"
iFilenum = FreeFile Open sFile For Input As iFilenum Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, stext9, sText10
Dim fileToOpen As Variant fileToOpen = Application.GetOpenFilename("tekstfiler (*.txt), *.txt") If fileToOpen <> False Then
Open fileToOpen For Input As #1 Do While Not EOF(1) Line Input #1, TXT Cells(2, 2).Offset(X, O) = TXT X = X + 1 Loop MsgBox "Opdateret Data!" Close #1 Else MsgBox "Filen blev ikke fundet!" End If End Sub
Open fileToOpen For Input As #1 Line Input #1, TXT ' hvad skal X starte med? X=0 Do While Not EOF(1) Cells(2, 2).Offset(X, O) = TXT X = X + 1 Line Input #1, TXT Loop MsgBox "Opdateret Data!" Close #1 Else MsgBox "Filen blev ikke fundet!" End If
Synes godt om
Slettet bruger
01. marts 2014 - 18:19#2
#claes57 Får den samme fejl. "bad file or bad number fejl 52"
Fundet ud af det. brugte det i den aktive ark. derfor din del ikke virkede, men fikse det med en Sheets("Ark2").Activate
Kan du evt. os hjælpe med den del med sti? min sti virker som er en under mappe. Men ville gerne have et loop ind i det, så jeg ikke skulle skrive alle de tal/kode pr. ligne. Som der driller lidt.
altså denne del:
Sub Read() Dim myPath As String myPath = ActiveWorkbook.Path Dim fnavn As String Dim strPath As String Dim strFileName As String On Error GoTo error
'Udskift stien med den ønskede sti If Len(Dir(myPath & "\Update\", vbDirectory)) = 0 Then MkDir myPath & "\Update\" End If strPath = myPath & "\Update\"
Application.DisplayAlerts = False ChDir (strPath) Dim sFile As String Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, _ sText7 As String, sText8 As String, sText10 As String Dim iFilenum As Integer
sFile = strPath & "Test.txt"
iFilenum = FreeFile Open sFile For Input As iFilenum Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, stext9, sText10
bruger jeg koden i et test Excel ark (Ny) så virker det. Bruger jeg det i det ark jeg skal bruge det i får jeg fejl.
Ligne jeg får fejl ved: Line Input #1, TXT
Men som sagt, virker det i et helt ny ark (Excel) Men bare ikke i det ark jeg skal bruge koden i. Intet bliver ændret i koden når jeg tester det i forskellige Excel ark (nye).
Sub Read() Dim myPath As String myPath = ActiveWorkbook.Path Dim fnavn As String Dim strPath As String Dim strFileName As String On Error GoTo error
'Aktive ark. Sheets("ark1").Activate
'Udskift stien med den ønskede sti If Len(Dir(myPath & "\Update\", vbDirectory)) = 0 Then MkDir myPath & "\Update\" End If strPath = myPath & "\Update\"
Application.DisplayAlerts = False ChDir (strPath) Dim sFile As String Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, _ sText7 As String, sText8 As String, sText10 As String Dim iFilenum As Integer
sFile = strPath & "Test.txt"
iFilenum = FreeFile Open sFile For Input As iFilenum Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, stext9, sText10
Dim fileToOpen As Variant fileToOpen = Application.GetOpenFilename("tekstfiler (*.txt), *.txt") If fileToOpen <> False Then
Open fileToOpen For Input As #1 Line Input #1, TXT ' hvad skal X starte med? X = 0 Do While Not EOF(1) Cells(2, 2).Offset(X, O) = TXT X = X + 1 Line Input #1, TXT Loop MsgBox "Opdateret Data!" Close #1 Else MsgBox "Filen blev ikke fundet!" End If End Sub
loop - er det Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, _ sText7 As String, sText8 As String, sText10 As String som du vil have rettet til noget simpelt. Så skal du bruge et array. Ser på det...
Synes godt om
Slettet bruger
04. marts 2014 - 13:21#7
#claes57 præcis. Men skal bare stadig være fra en undermappe.
det må (utestet) blive noget som (din kode er gemt - bare udkommenteret) og den kan tage op til 32000 linjer: Sub Read() Dim myPath As String myPath = ActiveWorkbook.Path Dim fnavn As String Dim strPath As String Dim strFileName As String On Error GoTo error
'Aktive ark. Sheets("ark1").Activate
'Udskift stien med den ønskede sti If Len(Dir(myPath & "\Update\", vbDirectory)) = 0 Then MkDir myPath & "\Update\" End If strPath = myPath & "\Update\"
Application.DisplayAlerts = False ChDir (strPath) Dim sFile As String Dim sText() As String Dim Taeller As Integer, Antal As Integer ' Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, sText7 As String, sText8 As String, sText10 As String Dim iFilenum As Integer
sFile = strPath & "Test.txt"
iFilenum = FreeFile Taeller = 0 Open sFile For Input As iFilenum ' hent data og placer i array While Not EOF(iFilenum) Taeller = Taeller + 1 Input #iFilenum, sText(Taeller) ' Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, stext9, sText10 Wend Close #iFilenum ' optimer array mht numre, så de passer til arkplacering ReDim Preserve sText(2 To Taeller + 1) For Antal = 2 To UBound(sText()) Range("B" & Antal) = sText(Antal) Next
Dim fileToOpen As Variant fileToOpen = Application.GetOpenFilename("tekstfiler (*.txt), *.txt") If fileToOpen <> False Then
Open fileToOpen For Input As #1 Line Input #1, TXT ' hvad skal X starte med? X = 0 Do While Not EOF(1) Cells(2, 2).Offset(X, O) = TXT X = X + 1 Line Input #1, TXT Loop MsgBox "Opdateret Data!" Close #1 Else MsgBox "Filen blev ikke fundet!" End If End Sub
Synes godt om
Slettet bruger
04. marts 2014 - 15:13#9
#claes57 jeg prøver at se om det virker når jeg er hjemme.
Så kunne du fx komme med fejlkode/sted. Men mon ikke den er i linjen As String, sText7 As String, sText8 As String, sText10 As String Som ser ud til at være tabt? Der skal en udkommentering foran, så det er ' As String, sText7 As String, sText8 As String, sText10 As String
Når du ikke kommer med nærmere fejlkode/linje, så er det løsningen. Jeg ved ikke, hvorfor fejl er hemmelig, men det styrer du bare selv. Læg et svar, og luk selv.
Synes godt om
Slettet bruger
21. marts 2014 - 20:48#16
Ja okej beklager at jeg ikke fik nævnt "fejl koden" ! Men det er "run-time error '9'"
og lignede er "Input #iFilenum, sText(Taeller)" som var nævnt.!
find linjen Dim sText() As String ret den til Dim sText As String()
Synes godt om
Slettet bruger
21. marts 2014 - 21:55#18
Acceptere den ikke.
"Compile error: Expected: end of statement"
Synes godt om
Slettet bruger
23. juni 2014 - 17:17#19
Lukker.
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
