Hallo,
ich habe eim kleines Problem:
Ich benötige ein Programm, mit welchem aus einem bestimmten (immer gleichen) Ordner alle .tab files aufgerufen werden, ein bestimmter Code dort ausgelesen wird und das muss dann zusammen mit einer Formel in eine Exel Tabelle.
Ich schaffe das ganze, wenn man jede Datei manuell eingibt, wie jedoch, dass er alle der Reihe nach abfragt und am besten dann auch gleich nach bearbeitung löscht?
Mein bisheriger Code:
Private Sub cmd1_Click()
PFAD = txtSuche.text
endung = lstDateien.text
strfilename = PFAD & endung
Dim m_WordDocument As Word.Document
Set m_WordDocument = CreateObject(„Word.Document“)
Word.Application.Visible = True
Word.Documents.Open (strfilename)
Selection.Find.ClearFormatting
With Selection.Find
.text = „^#^#^#^#^#^#“
.Replacement.text = „“
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Copy
'???
Workbooks.Open FileName:=„C:\Mappe2.xls“
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set Word = Nothing
End Sub
For i = 0 To lstDateien.ListCount - 1
If lstDateien.Selected(i) = True Then
cmd1.BackColor = red
End If
Next i
End Sub
Private Sub cmdEnde_Click()
Unload Me
End Sub
Private Sub cmdStart_Click()
Dim fsoFileSearch As FileSearch
Dim fileDatei As Variant
Dim intSuchkriterium As Integer
Dim iDateienGef As Integer
Dim strDateien() As String
On Error Resume Next
Me.lstDateien.Clear
If Len(Me.txtSuche.Value) = 0 Then
MsgBox „Bitte geben Sie das Verzeichnis ein, in dem gesucht werden soll.“
Me.txtSuche.SetFocus
Exit Sub
End If
If Right(Me.txtSuche.Value, 1) „“ Then
txtSuche.Value = txtSuche.Value & „“
End If
If Dir(txtSuche.Value) = „“ Then
MsgBox „Der angegebene Ordnername ist nicht korrekt.“
Me.txtText.Value = CurDir
Err.Clear
Exit Sub
End If
If Me.optDatum = True Then
intSuchkriterium = msoSortByLastModified
ElseIf Me.optGröße = True Then
intSuchkriterium = msoSortBySize
ElseIf Me.optName = True Then
intSuchkriterium = msoSortByFileName
ElseIf Me.optTyp = True Then
intSuchkriterium = msoSortByFileType
End If
Me.Caption = „“
Me.lstDateien.Clear
With Application.FileSearch
.NewSearch
.FileName = Me.cmbTyp
.LookIn = Me.txtSuche.Value
If Me.txtText.Value „“ Then
.TextOrProperty = Me.txtText.Value
End If
If .Execute(SortBy:=intSuchkriterium, sortorder:=msoSortOrderAscending, AlwaysAccurate:=True) > 0 Then
ReDim strZugehOrdner(.FoundFiles.Count)
ReDim strDateien(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
If InStr(1, .FoundFiles(i), „~“) = 0 Then
strDateien(i) = .FoundFiles(i)
strZugehOrdner(i) = .FoundFiles(i)
Do
strDateien(i) = Right(strDateien(i), _
(Len(strDateien(i)) - InStr(strDateien(i), „“)))
Loop While InStr(strDateien(i), „“) > 0
Me.lstDateien.AddItem strDateien(i)
End If
Next i
Else
Me.lstDateien.AddItem „Keine Entsprechungen gefunden!“
End If
End With
End Sub
Private Sub UserForm_Initialize()
With Me.cmbTyp
.AddItem „*.tab“
.ListIndex = 0
End With
Me.txtSuche.Value = CurDir
Me.Caption = „Dateiensuche“
End Sub