Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Dateien einlesen | Herbers Excel-Forum

• Dateien einlesen von BENNY vom 27.01.2010 10:54:43
• Mehrere Dateien auswählen und bearbeiten - von NoNet am 27.01.2010 11:18:39

Betrifft: Dateien einlesen von: BENNY
Geschrieben am: 27.01.2010 10:54:43

Hallo,

habe ein riesen Problem: Ich soll für meinen Arbeitgeber folgenden VBA Code (der fdf-Daten in Excel einliest) umbauen. Momentan kann man mit Hilfe dieses Codes EINE .fdf Datei einlesen und sie wird in Excel in zwei Zeilen (Zeile 1 (Überschrift) und Zeile 2 (Werte))ausgelesen.
Mein Chef möchte nun, dass man mehrere Dateien (auf einmal) auswählen und einlesen kann und diese dann eben in mehreren Zeilen untereinander stehen....
Praktisch diesen Code auf x-Dateien multiplizieren.
Ich habe überhaupt keine Ahnung und es wäre extrem wichtg für mich... Kann mir vielleicht jemand helfen? Ich wäre Euch so dankbar!

Benny

Public Sub DoAdobeImport() 
Dim FName As Variant 
Dim Sep1 As String 
Dim Sep2 As String 
Dim Sep3 As String 
Dim Sep4 As String 
Dim RowNdx As Integer 
Dim ColNdx As Integer 
Dim WholeLine As String 
Dim Pos As Integer 
Dim NextPos As Integer 
Dim StartPos As Integer 
Dim EndPos As Integer 
Dim recordPos As Integer 
Dim recordPos2 As Integer 
Dim SaveColNdx As Integer 
Dim Part1 As String 
Dim Part2 As String 
'get name of FDF file 
FName = Application.GetOpenFilename _ 
(filefilter:="Adobe FDF Data Files(*.fdf),*.fdf,All Files (*.*),*.*", Title:="Select FDF file    _
_
_
to import") 

If FName = False Then 
MsgBox "You didn't select a file" 
Exit Sub 
End If 
'Set record separators 
Application.ScreenUpdating = False 
Sep1 = ">" 
Sep3 = "/T" 
Sep4 = ")" 
'set cell row and column where to start entering data 
ColNdx = ActiveCell.Column 
RowNdx = ActiveCell.Row 
Open FName For Input Access Read As #1 'open fdf file 


Line Input #1, WholeLine 'Skip first three lines as they do not contain any data 
Line Input #1, WholeLine 
Line Input #1, WholeLine 
Line Input #1, WholeLine 
StartPos = (InStr(1, WholeLine, "[")) + 1 ' find where data starts 
EndPos = (InStr(1, WholeLine, "]")) - 1 ' find where data ends 
WholeLine = Mid(WholeLine, StartPos, EndPos) 'capture just the data fields 
Pos = 3 ' set start position 

NextPos = InStr(Pos, WholeLine, Sep2) 'find end of current record 
While NextPos >= 1 
TempVal = Mid(WholeLine, Pos, NextPos - Pos) 'Find start of next record 
recordPos = (InStr(1, TempVal, Sep4)) 'Go to end of record by using ")" 
'Assume the value is in A1, in B1 =Left(A1,len(A1)-2) 

Part1 = Trim(Mid(TempVal, 1, recordPos)) 'get data record name 

'*******Comment out the line below if you do not want data record name***** 
Cells(RowNdx, ColNdx).Value = Right((Left(Part1, Len(Part1) - 1)), Len((Left(Part1, Len(Part1) - _
 _
 _
 1))) - 3) ' trim off start and end superfluous characters and enter in cell 

'*******Comment out the line below if you do not want data record name***** 
RowNdx = RowNdx + 1 'move to next row 

recordPos2 = (InStr(1, TempVal, Sep4)) ' find ")" which is end of record 

Part2 = Trim(Mid(TempVal, recordPos2)) 'get data 
'Check to see if data field is blank 
If Part2 = Sep4 Then 
Cells(RowNdx, ColNdx).Value = "" 
'Check if Data is Yes or No 
ElseIf Right(Part2, 1) <> Sep4 Then 'trim off start and end superfluous characters and enter in  _
 _
 _
cell 
Cells(RowNdx, ColNdx).Value = Right((Left(Part2, Len(Part2) - 0)), Len((Left(Part2, Len(Part2) - _
 _
 _
 0))) - 4) ' trim off start and end superfluous characters and enter in cell 
Else 
Cells(RowNdx, ColNdx).Value = Right((Left(Part2, Len(Part2) - 1)), Len((Left(Part2, Len(Part2) - _
 _
 _
 1))) - 4) ' trim off start and end superfluous characters and enter in cell 
End If 

'Cells(RowNdx, ColNdx).Value = Trim(Mid(TempVal, recordPos2)) 'Second part which contains data 
ColNdx = ColNdx + 1 ' move to next column 

'*******Comment out the line below if you do not want data record name***** 
RowNdx = RowNdx - 1 ' move up a row 

Pos = NextPos + 4 ' move to start of next record record 
NextPos = InStr(Pos, WholeLine, Sep2) ' find end of next record 
'if more records loop again 
Wend 
'if no more records end 
Close #1 
End Sub

Betrifft: Mehrere Dateien auswählen und bearbeiten von: NoNet
Geschrieben am: 27.01.2010 11:18:39

Hallo Benny,

hier ein Grundgerüst :

Sub fdfDatenEinlesen()
    Dim fname 'Ohne TYPEN-Angabe, da VARIANT, ARRAY oder STRING sein kann !
    Dim lngF As Long
    fname = Application.GetOpenFilename _
        (filefilter:="Adobe FDF Data Files(*.fdf),*.fdf,All Files (*.*),*.*", _
        Title:="Select FDF file to import", MultiSelect:=True)

    If IsArray(fname) Then
        For lngF = LBound(fname) To UBound(fname)
            MsgBox fname(lngF), , "Datei Nr." & lngF
            'Hier Dein bisheriger Code : anstatt fname musst Du fName(lngF) verwenden !
        Next
    ElseIf fname = False Then
        MsgBox "You didn't select a file"
    End If
End Sub

Gruß, NoNet

Beiträge aus den Excel-Beispielen zum Thema "Dateien einlesen"