textdatei einfügen

Forumthread: textdatei einfügen

textdatei einfügen

28.02.2008 21:55:00

Jakobi

Hallo zusammen,
möchte an einer bestimmten Stelle einer Textdatei, den Inhalt einer anderen Textdatei einfügen.
Wie geht das?
Kann mir jemand helfen?
Danke im voraus
Gruß Jakobi

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: textdatei einfügen

28.02.2008 22:02:00

Gerd
AW: textdatei einfügen

28.02.2008 23:11:53

Jakobi
AW: textdatei einfügen

29.02.2008 01:18:30

Josef
AW: textdatei einfügen

01.03.2008 19:26:00

Jakobi
AW: textdatei einfügen

28.02.2008 22:45:54

Josef
Korrektur

28.02.2008 22:53:05

Josef

AW: textdatei einfügen

28.02.2008 22:02:00

Gerd

Hi,
"...möchte an einer bestimmten Stelle einer Textdatei..."
Woran lässt sich diese bestimmte Stelle ausmachen?
mfg Gerd

AW: textdatei einfügen

28.02.2008 23:11:53

Jakobi

Hallo Gerd,
die bestimmte Stelle wird an einer Einfügemarke festgemacht als Text z.B.:
"Protokollkopf"
Gruß
Jakob

AW: textdatei einfügen

29.02.2008 01:18:30

Josef

Hallo Jakobi,
dann so.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'###################################################################
'##Source:= http://www.vbarchiv.net/archiv/tipp_details.php?pid=301
'##
'##Modified by j.ehrensberger 29/02/2008
'###################################################################
Private Declare Function GetTempFilename Lib "kernel32" Alias _
    "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, _
    ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Declare Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Function TextFileTempFilename(Optional Path As String) As String
Dim myTempFileName As String
Dim RetVal As Long

If Path = "" Then
    Path = Space$(256)
    RetVal = GetTempPath(Len(Path), Path)
    Path = Left$(Path, RetVal)
End If

myTempFileName = Space$(256)

Call GetTempFilename(Path, "txt", 0&, myTempFileName)

myTempFileName = Left$(myTempFileName, InStr(myTempFileName, Chr$(0)) - 1)

TextFileTempFilename = myTempFileName

End Function

Public Function TextFileReadAll(ByVal FileName As String) As String
Dim F As Integer
Dim sInhalt As String

If Dir$(FileName, vbNormal) <> "" Then

    F = FreeFile

    Open FileName For Binary As #F
    sInhalt = Space$(LOF(F))
    Get #F, , sInhalt
    Close #F

End If

TextFileReadAll = sInhalt

End Function

Public Sub TextFileWriteLine(ByVal FileName As String, ByVal LinePos As Long, _
    ByVal NewString As String, Optional ByVal Replace As Boolean = True)
Dim F As Integer, N As Integer
Dim I As Long, lRow As Long
Dim Zeile As String, myTempFile As String

If Dir$(FileName, vbNormal) = "" Then

    F = FreeFile

    Open FileName For Output As #F

    For I = 1 To LinePos - 1
        Print #F, ""
    Next I

    Print #F, NewString

    Close #F

Else

    myTempFile = TextFileTempFilename()

    F = FreeFile: Open FileName For Input As #F
    N = FreeFile: Open myTempFile For Output As #N

    While Not EOF(F)

        lRow = lRow + 1

        Line Input #F, Zeile

        If lRow = LinePos Then
            If Replace Then
                Zeile = NewString
            Else
                Zeile = NewString & vbLf & Zeile
            End If
        End If

        Print #N, Zeile

    Wend

    If lRow < LinePos Then
        For I = lRow + 1 To LinePos - 1
            Print #N, ""
        Next I
        Print #N, NewString
    End If

    Close #F: Close #N

    Kill FileName
    FileCopy myTempFile, FileName
    Kill myTempFile

End If

End Sub

Private Function TextFileFindLine(ByVal FileName As String, SearchString As String) As Long
Dim F As Integer, l As Long
Dim sTmp As String

If Dir$(FileName, vbNormal) <> "" Then

    F = FreeFile

    Open FileName For Binary As #F

    Do While Not EOF(F)
        l = l + 1

        Line Input #F, sTmp

        If InStr(1, sTmp, SearchString) > 0 Then
            TextFileFindLine = l
            Exit Do
        End If

    Loop

    Close #F

End If
End Function

'###################################################################

Sub TextInText()
Dim strFile As String, strInsert As String, strTmp As String
Dim lLine As Long

strFile = "F:\Temp\Text.txt"
strInsert = "F:\Temp\Insert.txt"
lLine = TextFileFindLine(strFile, "Protokollkopf") + 1
strTmp = TextFileReadAll(strInsert)
TextFileWriteLine strFile, lLine, strTmp, False

End Sub

Gruß Sepp

AW: textdatei einfügen

01.03.2008 19:26:00

Jakobi

Danke Sepp!
Funktioniert hervorragend!!!!!!!!!
Jakobi

AW: textdatei einfügen

28.02.2008 22:45:54

Josef

Hallo Jakobi,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'###########################################################################################
'## Sorce:=http://www.vbarchiv.net/archiv/tipp_details.php?pid=301
'###########################################################################################
' Wird benötigt, zum Ermitteln des temporären
' Verzeichnisses und zum Erstellen temporärer Dateien
Private Declare Function GetTempFileName Lib "kernel32" _
    Alias "GetTempFileNameA" (ByVal lpszPath As String, _
    ByVal lpPrefixString As String, _
    ByVal wUnique As Long, _
    ByVal lpTempFileName As String) As Long

Private Declare Function GetTempPath Lib "kernel32.dll" _
    Alias "GetTempPathA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long

Private winTempPath As String

' Ermittelt einen temporären Dateinamen
' im temporären Verzeichnis
Private Function txt_TempFilename() As String
Dim myTempFileName As String
Dim RetVal As Long

If winTempPath = "" Then
    ' Temporäres Verzeichnis ermitteln
    winTempPath = Space$(256)
    RetVal = GetTempPath(Len(winTempPath), winTempPath)
    winTempPath = Left$(winTempPath, RetVal)
End If

' Temporären Dateinamen ermitteln
myTempFileName = Space$(256)
Call GetTempFileName(winTempPath, "txt", 0&, myTempFileName)
myTempFileName = Left$(myTempFileName, _
    InStr(myTempFileName, Chr$(0)) - 1)

txt_TempFilename = myTempFileName
End Function

Public Function txt_ReadAll(ByVal sFilename As String) As String
Dim F As Integer
Dim sInhalt As String

' Existiert die Datei ?
If Dir$(sFilename, vbNormal) <> "" Then
    ' Textdatei im Binärmodus öffnen und gesamten
    ' Inhalt in einem Rutsch auslesen
    F = FreeFile
    Open sFilename For Binary As #F
    sInhalt = Space$(LOF(F))
    Get #F, , sInhalt
    Close #F
End If

txt_ReadAll = sInhalt
End Function

Public Sub txt_WriteLine(ByVal sFilename As String, _
    ByVal LinePos As Long, ByVal sLine As String)

Dim F As Integer
Dim N As Integer
Dim I As Long
Dim lRow As Long
Dim Zeile As String
Dim myTempFile As String

If Dir$(sFilename, vbNormal) = "" Then
    ' Wenn Datei nicht existiert, automatisch erstellen
    ' und Inhalt sofort speichern
    F = FreeFile
    Open sFilename For Output As #F

    ' Datei mit Leerzeilen füllen, bis gewünschte
    ' Schreibposition erreicht ist
    For I = 1 To LinePos - 1
        Print #F, ""
    Next I

    ' Inhalt speichern
    Print #F, sLine
    Close #F

Else
    ' Temporäre Datei erstellen
    myTempFile = txt_TempFilename()

    ' Original-Datei zum Lesen und temporäre
    ' Datei zum Schreiben öffnen
    F = FreeFile: Open sFilename For Input As #F
    N = FreeFile: Open myTempFile For Output As #N

    ' Original-Datei einlesen und x. Zeile durch
    ' neuen Inhalt ersetzen
    lRow = 0
    While Not EOF(F)
        lRow = lRow + 1
        Line Input #F, Zeile

        '' 'Original
        '' If lRow = LinePos Then
        '' ' x. Zeile durch neuen Inhalt ersetzen
        '' Zeile = sLine
        '' End If
        ''
        '' Print #N, Zeile

        'Modifikation j.ehrensberger
        If lRow = LinePos Then
            Print #N, sLine & vbLf & Zeile
        Else
            Print #N, Zeile
        End If

    Wend

    ' sollte LinePos größer sein, als die bisherige
    ' Anzahl gespeicherter Zeilen in der Orginaldatei
    ' wurde der neue Inhalt noch nicht gespeichert
    ' und die Datei muss ggf. noch mit zusätzlichen
    ' Leerzeilen gefüllt werden!
    If lRow < LinePos Then
        ' Ggf. mit Leerzeilen füllen
        For I = lRow + 1 To LinePos - 1
            Print #N, ""
        Next I

        ' Neuen Zeilen-Inhalt speichern
        Print #N, sLine
    End If

    ' Dateien schliessen
    Close #F: Close #N

    ' Alte Datei löschen
    Kill sFilename

    ' temporäre Datei in "alte" Datei umbenennen
    FileCopy myTempFile, sFilename
    Kill myTempFile
End If
End Sub

'###########################################################################################

Sub TextInText()
Dim strFile As String, strInsert As String, strTmp As String
Dim lLine As Long

strFile = "F:\Temp\Text.txt" 'Textdatei in die Eingefügt wird
strInsert = "F:\Temp\Insert.txt" 'Textdatei deren Text eingefügt wird

lLine = 2 'zeile in welche eingefügt wird

strTmp = txt_ReadAll(strInsert)

txt_WriteLine strFile, 2, strTmp

End Sub

Gruß Sepp

Korrektur

28.02.2008 22:53:05

Josef

Hallo Jakobi,
da hat sich noch ein Fehler eingeschlichen. Die "Sub TextInText()" bitte gegen diese tauschen.
Sub TextInText()
Dim strFile As String, strInsert As String, strTmp As String
Dim lLine As Long

strFile = "F:\Temp\Text.txt" 'Textdatei in die Eingefügt wird
strInsert = "F:\Temp\Insert.txt" 'Textdatei deren Text eingefügt wird

lLine = 2 'zeile in welche eingefügt wird

strTmp = txt_ReadAll(strInsert)

txt_WriteLine strFile, lLine, strTmp

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Forumthread: textdatei einfügen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread