AW: suche erstzte in einem txt file
02.05.2015 23:12:49
Nepumuk
Hallo,
nochmal, dieses Programm kannst du nicht per VBA steuern !!!!!!!!!!!!!!!!!!!!!!!!!!
Ich hab das Programm nochmal geändert:
Option Explicit
Public Sub Beispiel()
Const SEARCH_TEXT As String = "'Hier Testen'"
Dim intFilenumber As Integer
Dim strText As String, strTemp As String
Dim objClipBoard As Object, objFile As Object
Dim objFileSystemObject As Object, objTextStream As Object
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
If .Count <> 0 Then Call .Delete
Call .Add("Textdateien", "*.txt")
End With
If .Show Then
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystemObject.GetFile(.SelectedItems(1))
Set objTextStream = objFile.OpenAsTextStream(1, -2)
strText = objTextStream.ReadAll
objTextStream.Close
If InStr(1, strText, SEARCH_TEXT) <> 0 Then
Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Copy
Set objClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Call objClipBoard.GetFromClipboard
strTemp = objClipBoard.GetText
strTemp = Left$(strTemp, Len(strTemp) - 2)
strText = Replace(strText, SEARCH_TEXT, strTemp)
Set objTextStream = objFile.OpenAsTextStream(2, -2)
Call objTextStream.Write(strText)
objTextStream.Close
Set objClipBoard = Nothing
Application.CutCopyMode = False
Else
Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")
End If
Set objTextStream = Nothing
Set objFile = Nothing
Set objFileSystemObject = Nothing
End If
End With
End Sub
Vor dem Test sieht meine Textdatei so aus:
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxy
'Hier Testen'
xxxxxxxxxxxxxxxxy
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
Nach dem Testen so:
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxy
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
xxxxxxxxxxxxxxxxy
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxx
Gruß
Nepumuk