Datei umbenennen und auslesen

Hallo alle zusammen,
da ich VBA-Neuling bin, würde ich mich über Hilfe freuen um ein paar Arbeitsschritte unter Excel2010 zu automatisieren.
Ich möchte über einen Auswahldialog eine Datei auswählen (*.hrn), Von dieser Datei soll eine Kopie als *.txt in einem anderen Ordner ("E:\neu\") gespeichert werden. Diese Datei besteht aus einen Header (mit 975 Zeichen) und unterschiedlich vielen Zeichensätzen a 325 Zeichen im Anschluss daran. Aus diesen Zeichensätzen möchte ich 4 Zeichenketten auslesen, die sich innerhalb des Zeichensatzes an immer den gleichen Stellen befinden und diese in eine Excel-Tabelle schreiben (jeweils eine Zeile pro Zeichensatz) und wieder unter dem gleichen Dateinamen als .xls in "E:\neu\"speichern.
Den Auswahldialog krieg ich schon hin, aber das Speichern unter dem gleichen Namen als .txt gelingt mir noch nicht. Einlesen von Zeichenketten geht über string=Mid(zeichenkette, startposition, anzahl einzulesender zeichen). Frei formuliert müsste das Auslesen in etwa so aussehen:
for i = 975 to dateiende step 325
str1 = mid(?, i+82,16)
str2 = mid(?, i+219,8)
str3 = mid(?, i+282,4)
str4 = mid(?, i+287,5)
aber wie speicher ich das jetzt in eine tabelle?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Oliver,
ungetestet!

' **********************************************************************
' Modul: Modul2  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub Daten_Einlesen_Spezial()
  Dim strTxt As String, strFile As String
  Dim lngIndex As Long, lngRow As Long, lngFirst As Long
  Dim lngStep As Long
  Dim objWB As Workbook
  Dim FF As Integer
  
  lngRow = 1
  lngStep = 325     'Zeilensprung
  lngFirst = 975    'Position erster Datensatz
  
  strFile = Application.GetOpenFilename("Textdateien (*.hrn),*.hrn")
  
  If strFile = "Falsch" Then Exit Sub
  
  FF = FreeFile
  
  Open strFile For Binary As #FF
  strTxt = Space(LOF(FF))
  Get #FF, , strTxt
  Close #FF
  
  If Len(strTxt) > lngFirst Then
    Set objWB = Workbooks.Add(xlWBATWorksheet)
    With objWB
      With .Sheets(1)
        For lngIndex = lngFirst To Len(strTxt) Step lngStep
          .Cells(lngRow, 1) = Mid(strTxt, lngIndex + 82, 16)
          .Cells(lngRow, 2) = Mid(strTxt, lngIndex + 219, 8)
          .Cells(lngRow, 3) = Mid(strTxt, lngIndex + 282, 4)
          .Cells(lngRow, 4) = Mid(strTxt, lngIndex + 287, 5)
          lngRow = lngRow + 1
        Next
      End With
      .SaveAs Left(strFile, InStrRev(strFile, ".") - 1) & ".xls"
      '.close 'Datei schließen?
    End With
  End If
  
  Set objWB = Nothing
End Sub

« Gruß Sepp »

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub test() Dim strFile As String, strNewName As String strFile = "E:\temp\Modul1.bas" strNewName = "E:\Temp\Test\Modul1.txt" If copyFile(strFile, strNewName) Then MsgBox "Die Datei '" & strFile & "' wurde efolgreich kopiert als '" & strNewName & "'!" Else MsgBox "Fehler beim kopieren von '" & strFile & "'!" End If End Sub Function copyFile(ByVal sourceFileName As String, targetFileName As String) As Long Dim objFSO As Object, objFile As Object On Error GoTo ErrExit: copyFile = -1 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(sourceFileName) objFile.Copy targetFileName, True GoTo GoOut ErrExit: copyFile = 0 GoOut: Set objFSO = Nothing Set objFile = Nothing End Function

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

21 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datei umbenennen und auslesen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

21 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread