Datei umbenennen und auslesen

Forumthread: Datei umbenennen und auslesen

Oliver

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

AW: Datei umbenennen und auslesen

15.08.2011 11:13:12

Oliver

Mir fällt gerade auf, dass das über die txt-Datei ja ein Umweg ist. Die hrn-Dateien habe ja schon ascii-Format, also müsste ich die ja auch direkt auslesen können...

AW: Datei umbenennen und auslesen

15.08.2011 11:43:45

Josef

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 »

AW: Datei umbenennen und auslesen

15.08.2011 12:24:46

Oliver

Hallo Josef,
funktioniert perfekt!!
Danke
Oliver

AW: Datei umbenennen und auslesen

15.08.2011 11:22:40

Josef

Hallo Oliver,
eine datei kopieren geht z. B. so.

' **********************************************************************
' 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

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Forumthread: Datei umbenennen und auslesen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Datei umbenennen und auslesen

Forumthread: Datei umbenennen und auslesen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread