VBA Code Texte einladen. Help

[sennox]

Hallo liebe Experten,

nach langer suche im Internet habe ich ein Code gefunden was meinen Wünschen zu 80% entspricht.
Da ich total der Anfänger in VBA bin brauche ich bitte eure Hilfe!

Ich möchte ca. 500 txt Dateien in Excel einladen über VBA. Die Texte der txt Dateien liegen zb in C:\Test

In Spalte A sollte der Dateiname der txt Datei stehen
In Spalte B der Textinhalt der txt Datei. ( Die Inhalte der txt Datei sind Höchsten 10 bis 20 Wörter, in vielen steht auch kein Text)

Der Code denn ich gefunden habe funktioniert wunderbar, nur läd er alles untereinander ein, möchste es aber nebeneinander. Und am liebsten wäre es mir wenn ich auf das Makro gehe das ich die TXT Dateien auch einzel auswählen kann.

Anbei der Code:

Code:

Option Explicit

Global txtpfad As String

Sub test()
Dim t As String, Datei As String

txtpfad = "C:\Test\"

Datei = Dir$(txtpfad & "*.txt")
While Len(Datei)
bearbeite Datei
Datei = Dir$
Wend

End Sub


Sub bearbeite(t As String)
Dim n As String, tmp As String
Static z As Long

n = Left$(t, InStrRev(t, ".") - 1)
Open txtpfad & t For Input As #2
z = z + 1
Cells(z, 1).Value = n '<-- Dateiname
While Not EOF(2)
Line Input #2, tmp
z = z + 1
Cells(z, 1).Value = tmp '<-- Textzeilen
Wend
z = z + 1
Cells(z, 1).Value = "---------------"

Close #2

End Sub

Vielen Dank schon mal an alle.

[atilla]

Hallo,

in einer Zeile wird geschrieben, wenn Du z und 1 tauschst.

[Zwergel]

Hi,

da der Fragesteller das angibt:

total der Anfänger

wirds das

z und 1 tauschst

eventuell nicht klar sein.

Z und 1 tauschen in den Codestellen

Cells(z, 1)

also dann so

Cells(1, z)

[Rabe]

Hi,

funktioniert das so?

Bei mir wird das "Global..." rot markiert als Fehler.

Code:

Option Explicit

Public txtpfad As String

Sub test()
   Dim t As String, Datei As String
  
   txtpfad = "C:\Test\"
  
   Datei = Dir$(txtpfad & "*.txt")
   While Len(Datei)
      bearbeite Datei
      Datei = Dir$
   Wend
  
End Sub


Sub bearbeite(t As String)
   Dim n As String, tmp As String
   Static z As Long
  
   n = Left$(t, InStrRev(t, ".") - 1)
   Open txtpfad & t For Input As #2
   z = z + 1
   Cells(1, z).Value = n '<-- Dateiname
   While Not EOF(2)
      Line Input #2, tmp
      z = z + 1
      Cells(1, z).Value = tmp '<-- Textzeilen
   Wend
   z = z + 1
   Cells(1, z).Value = "---------------"
  
   Close #2
  
End Sub

[sennox]

Hallo Ralf, 

so sieht es schon gut aus. 

Das Problem ist der ladet das jetzt neben einander ein.

Ich möchte das er das untereinander ladet. 

Sprich:

Dateiname / Textinhalt
Dateiname / Textinhalt
Dateiname / Textinhalt

Im Script sind noch so komische ---------- 
   Wend
   z = z + 1
   Cells(1, z).Value = "---------------"


Die will ich weg haben habe es schon probiert aber irgendwas mache ich Falsch. 

Danke und Gruß
Rafi

[Steffl]

Hallo,

versuche es mal so

Code:

Option Explicit

Private txtpfad As String

Sub test()
   Dim Datei As String
  
   txtpfad = "C:\Test\"
  
   Datei = Dir$(txtpfad & "*.txt")
   While Len(Datei)
      bearbeite Datei
      Datei = Dir$
   Wend
  
End Sub


Sub bearbeite(t As String)
   Dim n As String, tmp As String
   Static z As Long
  
   n = Left$(t, InStrRev(t, ".") - 1)
   Open txtpfad & t For Input As #2
   z = z + 1
   Cells(z, 1).Value = n '<-- Dateiname
   While Not EOF(2)
      Line Input #2, tmp
      z = z + 1
      Cells(z, 2).Value = tmp '<-- Textzeilen
   Wend
  
   Close #2
  
End Sub

[sennox]

Hallo Stefan 99% jetzt fehlt noch 1% :)

Dateiname ist in Spalte A1 so soll es sein. Aber Textinhalt ist in Spalte B2 sollte aber in Spalte B1 sein. 

Danke Gruß
Rafi

[Steffl]

Hallo,

ersetze das Makro bearbeite

PHP-Code:

Sub bearbeite(t As String)
   Dim n As String, tmp As String
   Static z As Long
   
   n = Left$(t, InStrRev(t, ".") - 1)
   Open txtpfad & t For Input As #2
   z = z + 1
   Cells(z, 1).Value = n '<-- Dateiname
   While Not EOF(2)
      Line Input #2, tmp
      Cells(z, 2).Value = tmp '<-- Textzeilen
   Wend
   
   Close #2
   
End Sub 


[sennox]

Hallo Stefan, 

es funktioniert!!! Vielen Dank :)

Natürlich auch alle anderen. 

Danke und eine Schönes Wochenende.

Viele Grüße
Rafi