Re: ARRAY schnell durchsuchen
23.05.2003 15:16:58
Dietmar
An Nepumuk
ich muß jetzt leider los,
hier noch die komplette SUB um die es geht. (Bin Montag wieder hier)
die TEST.xls ist diese Datei
in der WGT.txt sind Artikel Bez. + Nr + WGT
die TRAN*.*" sind sogenannte Transportbelege beinhaltet nur eine Artikel Nr und Kundendaten
Produkt.dat hier sollen die Daten gespeichertwerden
Sub TestCreateFile()
Dim iFile As Integer, iCounter As Integer
Dim sFileA As String 'für WGT ARRAY
Dim sFileB As String
Dim sFile As String, sTxt As String
Dim WGTOK As Boolean
XLSDatei = "TEST.xls"
Ordner = CODESRV & "\went-trans$\"
Extension = "TRAN*.*"
dName = Dir(Ordner & Extension)
iFile = FreeFile
sFileA = "S:\WGT.txt"
maxZeilen = 0
Zeile = 1
Open sFileA For Input As iFile
Do Until EOF(iFile)
Line Input #iFile, sTxt
maxZeilen = maxZeilen + 1
Loop
Close
iFile = FreeFile
Open sFileA For Input As iFile
ReDim WGT_Array(3, maxZeilen)
Do Until EOF(iFile)
Line Input #iFile, sTxt
WGT_Array(1, WGT_Zeilen) = CStr(Left(sTxt, 3)) 'WGT
WGT_Array(2, WGT_Zeilen) = CStr(Mid(sTxt, 5, 6)) 'BestellNr
WGT_Array(3, WGT_Zeilen) = CStr(Right(sTxt, Len(sTxt) - 11)) 'Bezeichnung
WGT_Zeilen = WGT_Zeilen + 1
Loop
Close
iCounter = 1
iFile = FreeFile
sFile = Application.Path & "\Produkt.dat"
Open sFile For Output As iFile
Do While dName <> ""
n = n + 1
If dName = Workbooks(XLSDatei).Sheets("TRANS-Dateien").Range("A" & n) Then GoTo Weiter
sFileB = Ordner & dName
AnzahlTrans = 0
Zeile = 1
Open sFileB For Input As iFile + 1
Do Until EOF(iFile + 1)
Line Input #iFile + 1, sTxt
AnzahlTrans = AnzahlTrans + 1
Loop
Close iFile + 1
Open sFileB For Input As iFile + 1
Do Until EOF(iFile + 1)
Line Input #iFile + 1, sTxt
'Zähler = 4 +1
'Gedruckt = 1 +1
'Dateiname = 20 +1 dName
'Datum = 10 +1 CStr(Mid(sTxt, 62, 10))
' = 3 +1 CStr(Mid(sTxt, 46, 3))
'TRANS ID = 12 CStr(Mid(sTxt, 12, 12))
'BestellNr. = 6 +1 CStr(Mid(sTxt, 24, 6))
'WGT = 3 +1
'Bezeichn. = offen
'Auftrag ID CStr(Mid(sTxt, 49, 13)) nichtverwendet
For Zeile = 1 To AnzahlTrans
WGTOK = False
x = iCounter
For w = 2 To WGT_Zeilen - 1
If WGT_Array(2, w) = CStr(Mid(sTxt, 24, 6)) Then
Print #iFile, iCounter & Space(4 - Len(x)) & "0" & Space(1) & dName & Space(1) & _
CStr(Mid(sTxt, 62, 10)) & Space(1) & _
CStr(Mid(sTxt, 46, 3)) & Space(1) & _
CStr(Mid(sTxt, 12, 12)) & Space(1) & _
CStr(Mid(sTxt, 24, 6)) & Space(1) & _
WGT_Array(1, w) & Space(1) & WGT_Array(3, w)
WGTOK = True
Exit For
End If
Next w
If WGTOK = False Then
Print #iFile, iCounter & Space(4 - Len(x)) & "0" & Space(1) & dName & Space(1) & _
CStr(Mid(sTxt, 62, 10)) & Space(1) & _
CStr(Mid(sTxt, 46, 3)) & Space(1) & _
CStr(Mid(sTxt, 12, 12)) & Space(1) & _
CStr(Mid(sTxt, 24, 6)) & Space(1)
End If
iCounter = iCounter + 1
Next Zeile
Schliessen:
Loop
Close iFile + 1
Weiter:
dName = Dir()
'Call refreshPB
Loop
Close iFile
Workbooks.OpenText _
Filename:=sFile, _
DataType:=xlDelimited, _
Tab:=False, _
semicolon:=False, _
comma:=False, _
Space:=False, _
other:=False
MsgBox "Weiter"
ActiveWorkbook.Close savechanges:=False
End Sub
Gruß Dietmar
PS (Bin Montag wieder hier)