Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

VB 6 Quellcode ersetzen

Frage Entwicklung VB for Applications

Mitglied: lordofremixes

lordofremixes (Level 1) - Jetzt verbinden

02.07.2012 um 16:40 Uhr, 5373 Aufrufe, 27 Kommentare

Würde gern VB 6 Quellcode durch neuen Code ersetzen, so dass das Programm wieder funktioniert.
Bitte dringend um Hilfe!

Würde gern den Quellcode ersetzen, mit gleicher Funktion, das Formular frmdeldir existiert nicht mehr !!

Weiß nicht mehr weiter, eigentlich müsste man die exe an 5 Stellen nur durch S18 (statt S05) ersetzen.
Das geht nicht (schon mit Hexeditor probiert.)
Es handelt sich um den folgenden VB 6 Code, der wegen dieser Stelle niccht kompiliert werden kann:

Hab es schon mit ausklammern probiert, aber dann löscht das Programm am Ende nicht die Verzeichnisse:

' Private Sub VerzeichnisseLoeschen()
' On Error GoTo EX
' If frmDelDir.chkDEL(0).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide
' If frmDelDir.chkDEL(1).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide
' If frmDelDir.chkDEL(2).Value = 1 Then Shell "cmd /c del /Q " & Erledigt(0) & "*.*", vbHide
' If frmDelDir.chkDEL(3).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide
' If frmDelDir.chkDEL(4).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide
' If frmDelDir.chkDEL(5).Value = 1 Then Shell "cmd /c del /Q " & Erledigt(1) & "*.*", vbHide
' Exit Sub
' EX:
' End Sub
27 Antworten
Mitglied: bastla
02.07.2012 um 18:00 Uhr
Hallo lordofremixes!

Es werden ja doch nur 6 "Checkbox"-Steuerelemente geprüft - die solltest Du ja auch im bestehenden Formular nachbauen können ...

... und falls ohnehin immer alle Löschvorgänge ausgeführt werden sollen, könntest Du auch einfach nur die Abfragen weglassen und jeweils nur den Teil nach "Then" verwenden.

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 18:30 Uhr
Hallo bastla,

auf dich hab ich gewartet!
Ok, , das bringt mich schon weiter.
Also ist es ein altes Formular das nicht mehr benötigt wird.

Kann man das so machen?
Habe 4 Listboxen namens:

lstXMLsource(0)
lstXMLsource(1)
lstXMLtarget(0)
lstXMLtarget(1)

wenn in diesen etwas "drin" ist, sollen die dazugehörigen Verzeichnisse auch gelöscht werden.
Kann man dies auch umsetzen? Z.B. so?

01.
Private Sub VerzeichnisseLoeschen() 
02.
On Error GoTo EX 
03.
If lstXMLsource(0).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
04.
If lstXMLtarget(0).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
05.
If lstXMLsource(1).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
06.
If lstXMLtarget(1)).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
07.
Exit Sub 
08.
EX: 
09.
End Sub
Gruß
lordofremixes
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 18:33 Uhr
Das Formular heißt übrigens frmXML2CRLF
So?


If frmXML2CRLF.lstXMLsource(0).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide
If frmXML2CRLF.lstXMLtarget(0).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide
If frmXML2CRLF.lstXMLsource(1).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide
If frmXML2CRLF.lstXMLtarget(1)).Value = 1 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide

?
Bitte warten ..
Mitglied: bastla
02.07.2012 um 18:35 Uhr
Hallo lordofremixes!

Bei einer Listbox sollte das eher so aussehen:
If frmXML2CRLF.lstXMLsource(0).Text = "1" Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide
Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 18:41 Uhr
Hallo,

wird ausprobiert!
Benötigt man die Anführungszeichen bei der 1 ?

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012 um 18:47 Uhr
Hallo lordofremixes!
Benötigt man die Anführungszeichen bei der 1 ?
Ich würde sie nicht brauchen, aber der VB6-Interpreter/-Compiler könnte meinen, dass eine Eigenschaft "Text" auch einen Eigenschaftswert mit dem Typ "Text" hat ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 18:56 Uhr
Hallo bastla,

kompilieren geht, aber die Datei wird nicht gelöscht obwohl in der Listbox noch eine steht und auch im Ordner..
Ich glaube es liegt an der Reihenfolge des Codes?
Kann ich mal den letzten Teil des Quellcodes posten oder den ganzen?
Vielleicht siehst du gleich was da nicht stimmt...

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012 um 19:02 Uhr
Hallo lordofremixes!
obwohl in der Listbox noch eine steht und auch im Ordner..
Dem Satz fehlt etwas Entscheidendes ...
Quellcode posten sollte nicht verkehrt sein ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:02 Uhr
01.
Option Explicit 
02.
'Dieses Programm fügt in eine einzeilige XML-Datei Zeileinumbrüche ein 
03.
 
04.
 
05.
Dim Speed As Long 
06.
Dim Rechnername As String 
07.
Dim ViewModus As Boolean 
08.
Dim Rechner As String 
09.
Dim SourceDir(1) As String 
10.
Dim TargetDir(1) As String 
11.
Dim Erledigt(1) As String 
12.
 
13.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As Any, ByVal lpParameters As Any, ByVal lpDirectory As Any, ByVal nShowCmd As Long) As Long 
14.
 
15.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long) 
16.
 
17.
Private Sub VerzeichnisAuslesen(i As Byte) 
18.
Dim v As Long 
19.
Dim cFile As String 
20.
    lstXMLsource(i).Clear 
21.
    v = 0 
22.
    cFile = Dir(SourceDir(i) & "*.XML") ' Alle Textdateien im Quellverzeichnis ausgeben 
23.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
24.
        lstXMLsource(i).AddItem (cFile) 
25.
        v = v + 1 
26.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
27.
    Loop 
28.
    lblSource(i).Caption = SourceDir(i) & " - " & lstXMLsource(i).ListCount & " Dateien" 
29.
    v = 0 
30.
    lstXMLtarget(i).Clear 
31.
    cFile = Dir(TargetDir(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
32.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
33.
        lstXMLtarget(i).AddItem (cFile) 
34.
        v = v + 1 
35.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
36.
    Loop 
37.
    lblTarget(i).Caption = TargetDir(i) & " - " & lstXMLtarget(i).ListCount & " Dateien" 
38.
    'lblAlt(i).Caption = "erledigt - " & lstXMLalt(i).ListCount & " Dateien" 
39.
    v = 0 
40.
    lstXMLalt(i).Clear 
41.
    cFile = Dir(Erledigt(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
42.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
43.
        lstXMLalt(i).AddItem (cFile) 
44.
        v = v + 1 
45.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
46.
    Loop 
47.
    lblAlt(i).Caption = Erledigt(i) & " - " & lstXMLalt(i).ListCount & " Dateien" 
48.
     
49.
End Sub 
50.
 
51.
Private Sub VerzeichnisVergleichen(l As Byte) 
52.
Dim i As Long 
53.
Dim j As Long 
54.
Dim a As Long 
55.
Dim b As Long 
56.
Dim c As Long 
57.
Dim konvertiert As Boolean 
58.
 
59.
konvertiert = False 
60.
    For i = 0 To lstXMLsource(l).ListCount - 1 
61.
        a = lstXMLsource(l).ListCount - 1 
62.
        b = lstXMLalt(l).ListCount - 1 
63.
        If b - a < a Then 
64.
            c = 0 
65.
        Else 
66.
            c = b - a 
67.
        End If 
68.
        For j = c To lstXMLalt(l).ListCount - 1 
69.
            If lstXMLsource(l).List(i) = lstXMLalt(l).List(j) Then konvertiert = True 
70.
        Next j 
71.
        If konvertiert = False Then 
72.
            XML_umwandeln lstXMLsource(l).List(i), l 
73.
            konvertiert = False 
74.
        Else 
75.
            konvertiert = False 
76.
        End If 
77.
    Next i 
78.
End Sub 
79.
 
80.
Private Sub XML_umwandeln(XML_Datei As String, m As Byte) 
81.
Dim Datei2 As String 
82.
Dim Datei3 As String 
83.
Dim Datei4 As String 
84.
Dim Datei5 As String 
85.
Dim StrAusgabe As String 
86.
Dim StrA As String 
87.
Dim Erkennen As Boolean 
88.
Dim i As Long 
89.
Dim j As Long 
90.
Dim k As Byte 
91.
Dim l As Byte 
92.
Dim n As Byte 
93.
Dim Zust800 As Boolean 
94.
Dim Zeichen(10000000) As String 
95.
 
96.
On Error GoTo EX 
97.
    StrAusgabe = "" 
98.
    StrA = "" 
99.
    Datei2 = SourceDir(m) & XML_Datei 
100.
    Datei3 = TargetDir(m) & XML_Datei 
101.
    Datei4 = Erledigt(m) & XML_Datei 
102.
    Datei5 = "C:\ErpInterface\COP.bat" 
103.
    'lstXMLalt(m).AddItem (XML_Datei) 
104.
    i = 0 
105.
    Zust800 = False 
106.
    Open Datei2 For Input As #2 
107.
        Do While Not EOF(2)    'Schleife bis Dateiende. 
108.
           Line Input #2, Zeichen(i) 
109.
           i = i + 1 
110.
        Loop 
111.
    Close #2 
112.
 
113.
    If i > 1 Then               'Wenn XML-Datei aus mehr als einer Zeile besteht, wird sie so wieder ausgegeben 
114.
        'Open Datei3 For Output As #3 
115.
        Open Datei4 For Output As #4 
116.
            For j = 0 To i 
117.
                'Print #3, Zeichen(j) 
118.
                Print #4, Zeichen(j) 
119.
            Next j 
120.
        'Close #3 
121.
        Close #4 
122.
    Else 
123.
        j = Len(Zeichen(0)) 
124.
        If chk800.Value = 1 Then 
125.
            For i = 1 To j 
126.
                If Mid(Zeichen(0), i, 4) = "T" & Chr$(34) & ">8" Then 
127.
                    Zust800 = True 
128.
                End If 
129.
            Next i 
130.
        End If 
131.
        Erkennen = True         '=> Suche nach einem neunen Erkennung String "<XYZ " 
132.
        'If Zust800 = False Then Open Datei3 For Output As #3 
133.
        Open Datei4 For Output As #4 
134.
        If Zust800 = True Then 
135.
            Print #4, 
136.
            Print #4, 
137.
            Print #4, "<! ! ! ! !         Pruefmittel, nicht importiert              ! ! ! ! !>" 
138.
            Print #4, 
139.
            Print #4, 
140.
        End If 
141.
            For i = 1 To j 
142.
                StrAusgabe = StrAusgabe & Mid(Zeichen(0), i, 1) 
143.
                If Erkennen = True Then StrA = StrA & Mid(Zeichen(0), i, 1) 
144.
                If Mid(Zeichen(0), i, 1) = "<" Then 
145.
                    StrA = "" 
146.
                    Erkennen = True 
147.
                End If 
148.
                If Mid(Zeichen(0), i, 1) = " " Then 
149.
                    k = Len(StrA) 
150.
                    Erkennen = False 
151.
                End If 
152.
                If Erkennen = False And Mid(Zeichen(0), i, 1) = "<" And Mid(Zeichen(0), i, 2) <> "</" Then 
153.
                    Erkennen = True 
154.
                End If 
155.
      
156.
                If i > 5 Then 
157.
                    If Mid(Zeichen(0), i - 1, 2) = "?>" _ 
158.
                       Or Mid(Zeichen(0), i, 2) = "><" And Mid(Zeichen(0), i + 2, 1) <> "/" _ 
159.
                       Or (Mid(Zeichen(0), i, 1) = ">" And Erkennen = True) _ 
160.
                       And (Mid(Zeichen(0), i - 5, 6) <> "sCode>" And i > 11) _ 
161.
                       And (Mid(Zeichen(0), i - 5, 6) <> "ssage>" And i > 11) Then 
162.
                       If chkGew.Value = 1 And Left(StrAusgabe, 4) = "<gew" Then 
163.
                        For n = 30 To 40 
164.
                            If Mid(StrAusgabe, n, 1) = "<" Then 
165.
                                'alles ok, String kann ganz normal geschrieben werden 
166.
                                'If Zust800 = False Then Print #3, StrAusgabe 
167.
                                Print #4, StrAusgabe 
168.
                                Exit For 
169.
                            End If 
170.
                            If Mid(StrAusgabe, n, 1) = "E" Then 
171.
                                'Gewicht wird auf NULL gesetzt 
172.
                                '<gewicht FIELDNAME="NFT_FLO0">8.4E-05</gewicht> 
173.
                                '123456789012345678901234567890 
174.
                                'If Zust800 = False Then Print #3, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
175.
                                Print #4, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
176.
                                Exit For 
177.
                            End If 
178.
                        Next n 
179.
                       Else 
180.
                        'If Zust800 = False Then Print #3, StrAusgabe 
181.
                        Print #4, StrAusgabe 
182.
                       End If 
183.
                        StrAusgabe = "" 
184.
                        Erkennen = False 
185.
                    End If 
186.
                End If 
187.
            Next i 
188.
        'f Zust800 = False Then Close #3 
189.
        Close #4 
190.
    End If 
191.
If Zust800 = False Then Shell "cmd /c copy " & Datei4 & " " & Datei3, vbHide 
192.
Exit Sub 
193.
EX: 
194.
Close #2 
195.
'Close #3 
196.
Close #4 
197.
End Sub 
198.
 
199.
Private Sub cmdChangeDir_Click() 
200.
        If SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" Then 
201.
            SourceDir(0) = Rechner & "\ErpInterface\ERPRequestResponse\" 
202.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequestResponse\" 
203.
        Else 
204.
            SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
205.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
206.
        End If 
207.
        lblSource(0).Caption = SourceDir(0) 
208.
        lblTarget(0).Caption = TargetDir(0) 
209.
        lstXMLalt(0).Clear 
210.
        lstXMLsource(0).Clear 
211.
        lstXMLtarget(0).Clear 
212.
End Sub 
213.
 
214.
Private Sub cmdDELA_Click(Index As Integer) 
215.
On Error GoTo EX 
216.
    If Index = 0 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
217.
    If Index = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
218.
    If Index = 2 Then Shell "cmd /c del /Q " & Erledigt(0) & "*.*", vbHide 
219.
    If Index = 3 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
220.
    If Index = 4 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
221.
    If Index = 5 Then Shell "cmd /c del /Q " & Erledigt(1) & "*.*", vbHide 
222.
Exit Sub 
223.
EX: 
224.
End Sub 
225.
 
226.
Private Sub cmdDELM_Click(Index As Integer) 
227.
    Dim i As Long 
228.
On Error GoTo EX 
229.
    If Index = 0 Then 
230.
        For i = 0 To lstXMLsource(0).ListCount - 1 
231.
            If lstXMLsource(0).Selected(i) Then 
232.
                lstXMLsource(0).RemoveItem (i) 
233.
                Shell "cmd /c del /Q " & SourceDir(0) & lstXMLsource(0).List(i) 
234.
                Exit For 
235.
            End If 
236.
        Next i 
237.
    End If 
238.
    If Index = 1 Then 
239.
        For i = 0 To lstXMLtarget(0).ListCount - 1 
240.
            If lstXMLtarget(0).Selected(i) Then 
241.
                lstXMLtarget(0).RemoveItem (i) 
242.
                Shell "cmd /c del /Q " & TargetDir(0) & lstXMLtarget(0).List(i) 
243.
                Exit For 
244.
            End If 
245.
        Next i 
246.
    End If 
247.
    If Index = 2 Then 
248.
        For i = 0 To lstXMLalt(0).ListCount - 1 
249.
            If lstXMLalt(0).Selected(i) Then 
250.
                lstXMLalt(0).RemoveItem (i) 
251.
                Shell "cmd /c del /Q " & Erledigt(0) & lstXMLalt(0).List(i) 
252.
                Exit For 
253.
            End If 
254.
        Next i 
255.
    End If 
256.
     
257.
    If Index = 3 Then 
258.
        For i = 0 To lstXMLsource(1).ListCount - 1 
259.
            If lstXMLsource(1).Selected(i) Then 
260.
                lstXMLsource(1).RemoveItem (i) 
261.
                Shell "cmd /c del /Q " & SourceDir(1) & lstXMLsource(1).List(i) 
262.
                Exit For 
263.
            End If 
264.
        Next i 
265.
    End If 
266.
    If Index = 4 Then 
267.
        For i = 0 To lstXMLtarget(1).ListCount - 1 
268.
            If lstXMLtarget(1).Selected(i) Then 
269.
                lstXMLtarget(1).RemoveItem (i) 
270.
                Shell "cmd /c del /Q " & TargetDir(1) & lstXMLtarget(1).List(i) 
271.
                Exit For 
272.
            End If 
273.
        Next i 
274.
    End If 
275.
    If Index = 5 Then 
276.
        For i = 0 To lstXMLalt(1).ListCount - 1 
277.
            If lstXMLalt(1).Selected(i) Then 
278.
                lstXMLalt(1).RemoveItem (i) 
279.
                Shell "cmd /c del /Q " & Erledigt(1) & lstXMLalt(1).List(i) 
280.
                Exit For 
281.
            End If 
282.
        Next i 
283.
    End If 
284.
Exit Sub 
285.
EX: 
286.
End Sub 
287.
 
288.
Private Sub Form_Unload(Cancel As Integer) 
289.
End 
290.
End Sub 
291.
 
292.
 Private Sub VerzeichnisseLoeschen() 
293.
 On Error GoTo EX 
294.
If frmXML2CRLF.lstXMLsource(0).Text = "1" Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
295.
If frmXML2CRLF.lstXMLtarget(0).Text = "1" Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
296.
If frmXML2CRLF.lstXMLsource(1).Text = "1" Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
297.
If frmXML2CRLF.lstXMLtarget(1).Text = "1" Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
298.
 
299.
 
300.
 Exit Sub 
301.
EX: 
302.
 End Sub 
303.
  
304.
  
305.
 
306.
'Private Sub lstXMLalt_Click(Index As Integer) 
307.
'Dim i As Long 
308.
'Dim Datei As String 
309.
'Dim Info As String 
310.
'On Error GoTo EX 
311.
'If Index = 0 Then 
312.
'    For i = 0 To lstXMLalt(Index).ListCount - 1 
313.
'        If lstXMLalt(Index).Selected(i) Then 
314.
'            Datei = Left(lstXMLalt(Index).List(i), 40) 
315.
'            Datei = Erledigt(Index) & Datei 
316.
'        End If 
317.
'    Next i 
318.
'    Open Datei For Input As #2 
319.
'        Do While Not EOF(2)    'Schleife bis Dateiende. 
320.
'           Line Input #2, Info 
321.
'        Loop 
322.
'    Close #2 
323.
'End If 
324.
'Exit Sub 
325.
'EX: 
326.
'End Sub 
327.
 
328.
Private Sub lstXMLalt_DblClick(Index As Integer) 
329.
Dim i As Long 
330.
Dim Datei As String 
331.
On Error GoTo EX 
332.
For i = 0 To lstXMLalt(Index).ListCount - 1 
333.
    If lstXMLalt(Index).Selected(i) Then 
334.
        Datei = Left(lstXMLalt(Index).List(i), 40) 
335.
        ShellExecute Me.hWnd, "Open", Erledigt(Index) & Datei, "", App.Path, 1 
336.
    End If 
337.
Next i 
338.
Exit Sub 
339.
EX: 
340.
End Sub 
341.
 
342.
Private Sub lstXMLsource_dblClick(Index As Integer) 
343.
Dim i As Long 
344.
Dim Datei As String 
345.
On Error GoTo EX 
346.
For i = 0 To lstXMLsource(Index).ListCount - 1 
347.
    If lstXMLsource(Index).Selected(i) Then 
348.
        Datei = (Left(lstXMLsource(Index).List(i), 40)) 
349.
        'ShellExecute Me.hWnd, "Open", SourceDir(Index) & lstXMLsource(Index).List(i), "", App.Path, 1 
350.
        ShellExecute Me.hWnd, "Open", SourceDir(Index) & Datei, "", App.Path, 1 
351.
        'MsgBox (SourceDir(Index) & Datei) 
352.
    End If 
353.
Next i 
354.
Exit Sub 
355.
EX: 
356.
End Sub 
357.
 
358.
Private Sub lstXMLtarget_dblClick(Index As Integer) 
359.
Dim i As Long 
360.
Dim Datei As String 
361.
On Error GoTo EX 
362.
For i = 0 To lstXMLtarget(Index).ListCount - 1 
363.
    If lstXMLtarget(Index).Selected(i) Then 
364.
        Datei = Left(lstXMLtarget(Index).List(i), 40) 
365.
        ShellExecute Me.hWnd, "Open", TargetDir(Index) & Datei, "", App.Path, 1 
366.
    End If 
367.
Next i 
368.
Exit Sub 
369.
EX: 
370.
End Sub 
371.
 
372.
Private Sub tmrXML_Timer() 
373.
    VerzeichnisAuslesen 0 
374.
    If ViewModus = False Then VerzeichnisVergleichen 0 
375.
    VerzeichnisAuslesen 1 
376.
    If ViewModus = False Then VerzeichnisVergleichen 1 
377.
End Sub 
378.
 
379.
Private Sub Form_Load() 
380.
     
381.
    ViewModus = False 
382.
    Rechnername = Environ("COMPUTERNAME") 
383.
 
384.
    'Rechnername = "S18"      'Zum Testen um S18 vorzuspielen 
385.
    frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    Rechner: " & Rechnername 
386.
     
387.
    If Command() = "v" Or Command() = "V" Or Rechnername <> "S18" Then 
388.
        ViewModus = True 
389.
        MsgBox ("Das Programm läuft nur im View-Modus!") 
390.
        frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    ! View Modus !" 
391.
        Speed = 10000    'Timer 10 Sekunden 
392.
        txtSpeed.Text = Speed 
393.
    Else 
394.
        Speed = 2500    'Timer 2,5 Sekunden 
395.
        txtSpeed.Text = Speed 
396.
        If App.PrevInstance = True And Rechnername = "S18" Then 
397.
            'MsgBox ("Das Programm läuft nur im View-Modus!") 
398.
            End 
399.
        End If 
400.
    End If 
401.
     
402.
    Rechner = "C:"        'Zum Testen ohne Netz 
403.
    'Rechner = "\\S18"    'Echteinstellung 
404.
     
405.
    SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
406.
    TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
407.
    Erledigt(0) = Rechner & "\ErpInterface\OKRequest\" 
408.
    SourceDir(1) = Rechner & "\ErpInterface\ERPRequestResponse\" 
409.
    TargetDir(1) = Rechner & "\ErpInterface\TSRequestResponse\" 
410.
    Erledigt(1) = Rechner & "\ErpInterface\OKRequestResponse\" 
411.
     
412.
    lblSource(0).Caption = SourceDir(0) 
413.
    lblTarget(0).Caption = TargetDir(0) 
414.
    lblSource(1).Caption = SourceDir(1) 
415.
    lblTarget(1).Caption = TargetDir(1) 
416.
     
417.
'    If Command() = "d" Or Command() = "D" Or ViewModus = False Then 
418.
'        frmXML2CRLF.Visible = True 
419.
'        'VerzeichnisseLoeschen 
420.
'    End If 
421.
    tmrXML.Interval = Speed 
422.
 
423.
End Sub 
424.
 
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:03 Uhr
Hallo bastla,

noch eine xml datei steht und auch im Ordner!
Wenn du ein Bild vom Formular brauchst, würd ich dir ne pm schicken..

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012 um 19:10 Uhr
Hallo lordofremixes!

Wenn in der Listbox nicht "1" steht, ist es wenig sinnvoll, per "If" danach zu fragen - dann würde sich eher etwas in der Art anbieten:
If frmXML2CRLF.lstXMLsource(0).Text <> "" Then Shell "cmd /c del /Q " & frmXML2CRLF.lstXMLsource(0).Text, vbHide
Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:22 Uhr
Hallo bastla,

genauso eingefügt. Aber in der Listbox steht noch die xml Datei, und im dazugehörigen Verzeichnis auch!

Das ist der angepasste Code.

01.
 
02.
Option Explicit 
03.
'Dieses Programm fügt in eine einzeilige XML-Datei Zeileinumbrüche ein 
04.
'Torsten Schacht 27.05.2008 
05.
 
06.
Dim Speed As Long 
07.
Dim Rechnername As String 
08.
Dim ViewModus As Boolean 
09.
Dim Rechner As String 
10.
Dim SourceDir(1) As String 
11.
Dim TargetDir(1) As String 
12.
Dim Erledigt(1) As String 
13.
 
14.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As Any, ByVal lpParameters As Any, ByVal lpDirectory As Any, ByVal nShowCmd As Long) As Long 
15.
 
16.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long) 
17.
 
18.
Private Sub VerzeichnisAuslesen(i As Byte) 
19.
Dim v As Long 
20.
Dim cFile As String 
21.
    lstXMLsource(i).Clear 
22.
    v = 0 
23.
    cFile = Dir(SourceDir(i) & "*.XML") ' Alle Textdateien im Quellverzeichnis ausgeben 
24.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
25.
        lstXMLsource(i).AddItem (cFile) 
26.
        v = v + 1 
27.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
28.
    Loop 
29.
    lblSource(i).Caption = SourceDir(i) & " - " & lstXMLsource(i).ListCount & " Dateien" 
30.
    v = 0 
31.
    lstXMLtarget(i).Clear 
32.
    cFile = Dir(TargetDir(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
33.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
34.
        lstXMLtarget(i).AddItem (cFile) 
35.
        v = v + 1 
36.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
37.
    Loop 
38.
    lblTarget(i).Caption = TargetDir(i) & " - " & lstXMLtarget(i).ListCount & " Dateien" 
39.
    'lblAlt(i).Caption = "erledigt - " & lstXMLalt(i).ListCount & " Dateien" 
40.
    v = 0 
41.
    lstXMLalt(i).Clear 
42.
    cFile = Dir(Erledigt(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
43.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
44.
        lstXMLalt(i).AddItem (cFile) 
45.
        v = v + 1 
46.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
47.
    Loop 
48.
    lblAlt(i).Caption = Erledigt(i) & " - " & lstXMLalt(i).ListCount & " Dateien" 
49.
     
50.
End Sub 
51.
 
52.
Private Sub VerzeichnisVergleichen(l As Byte) 
53.
Dim i As Long 
54.
Dim j As Long 
55.
Dim a As Long 
56.
Dim b As Long 
57.
Dim c As Long 
58.
Dim konvertiert As Boolean 
59.
 
60.
konvertiert = False 
61.
    For i = 0 To lstXMLsource(l).ListCount - 1 
62.
        a = lstXMLsource(l).ListCount - 1 
63.
        b = lstXMLalt(l).ListCount - 1 
64.
        If b - a < a Then 
65.
            c = 0 
66.
        Else 
67.
            c = b - a 
68.
        End If 
69.
        For j = c To lstXMLalt(l).ListCount - 1 
70.
            If lstXMLsource(l).List(i) = lstXMLalt(l).List(j) Then konvertiert = True 
71.
        Next j 
72.
        If konvertiert = False Then 
73.
            XML_umwandeln lstXMLsource(l).List(i), l 
74.
            konvertiert = False 
75.
        Else 
76.
            konvertiert = False 
77.
        End If 
78.
    Next i 
79.
End Sub 
80.
 
81.
Private Sub XML_umwandeln(XML_Datei As String, m As Byte) 
82.
Dim Datei2 As String 
83.
Dim Datei3 As String 
84.
Dim Datei4 As String 
85.
Dim Datei5 As String 
86.
Dim StrAusgabe As String 
87.
Dim StrA As String 
88.
Dim Erkennen As Boolean 
89.
Dim i As Long 
90.
Dim j As Long 
91.
Dim k As Byte 
92.
Dim l As Byte 
93.
Dim n As Byte 
94.
Dim Zust800 As Boolean 
95.
Dim Zeichen(10000000) As String 
96.
 
97.
On Error GoTo EX 
98.
    StrAusgabe = "" 
99.
    StrA = "" 
100.
    Datei2 = SourceDir(m) & XML_Datei 
101.
    Datei3 = TargetDir(m) & XML_Datei 
102.
    Datei4 = Erledigt(m) & XML_Datei 
103.
    Datei5 = "C:\ErpInterface\COP.bat" 
104.
    'lstXMLalt(m).AddItem (XML_Datei) 
105.
    i = 0 
106.
    Zust800 = False 
107.
    Open Datei2 For Input As #2 
108.
        Do While Not EOF(2)    'Schleife bis Dateiende. 
109.
           Line Input #2, Zeichen(i) 
110.
           i = i + 1 
111.
        Loop 
112.
    Close #2 
113.
 
114.
    If i > 1 Then               'Wenn XML-Datei aus mehr als einer Zeile besteht, wird sie so wieder ausgegeben 
115.
        'Open Datei3 For Output As #3 
116.
        Open Datei4 For Output As #4 
117.
            For j = 0 To i 
118.
                'Print #3, Zeichen(j) 
119.
                Print #4, Zeichen(j) 
120.
            Next j 
121.
        'Close #3 
122.
        Close #4 
123.
    Else 
124.
        j = Len(Zeichen(0)) 
125.
        If chk800.Value = 1 Then 
126.
            For i = 1 To j 
127.
                If Mid(Zeichen(0), i, 4) = "T" & Chr$(34) & ">8" Then 
128.
                    Zust800 = True 
129.
                End If 
130.
            Next i 
131.
        End If 
132.
        Erkennen = True         '=> Suche nach einem neunen Erkennung String "<XYZ " 
133.
        'If Zust800 = False Then Open Datei3 For Output As #3 
134.
        Open Datei4 For Output As #4 
135.
        If Zust800 = True Then 
136.
            Print #4, 
137.
            Print #4, 
138.
            Print #4, "<! ! ! ! !         Pruefmittel, nicht importiert              ! ! ! ! !>" 
139.
            Print #4, 
140.
            Print #4, 
141.
        End If 
142.
            For i = 1 To j 
143.
                StrAusgabe = StrAusgabe & Mid(Zeichen(0), i, 1) 
144.
                If Erkennen = True Then StrA = StrA & Mid(Zeichen(0), i, 1) 
145.
                If Mid(Zeichen(0), i, 1) = "<" Then 
146.
                    StrA = "" 
147.
                    Erkennen = True 
148.
                End If 
149.
                If Mid(Zeichen(0), i, 1) = " " Then 
150.
                    k = Len(StrA) 
151.
                    Erkennen = False 
152.
                End If 
153.
                If Erkennen = False And Mid(Zeichen(0), i, 1) = "<" And Mid(Zeichen(0), i, 2) <> "</" Then 
154.
                    Erkennen = True 
155.
                End If 
156.
      
157.
                If i > 5 Then 
158.
                    If Mid(Zeichen(0), i - 1, 2) = "?>" _ 
159.
                       Or Mid(Zeichen(0), i, 2) = "><" And Mid(Zeichen(0), i + 2, 1) <> "/" _ 
160.
                       Or (Mid(Zeichen(0), i, 1) = ">" And Erkennen = True) _ 
161.
                       And (Mid(Zeichen(0), i - 5, 6) <> "sCode>" And i > 11) _ 
162.
                       And (Mid(Zeichen(0), i - 5, 6) <> "ssage>" And i > 11) Then 
163.
                       If chkGew.Value = 1 And Left(StrAusgabe, 4) = "<gew" Then 
164.
                        For n = 30 To 40 
165.
                            If Mid(StrAusgabe, n, 1) = "<" Then 
166.
                                'alles ok, String kann ganz normal geschrieben werden 
167.
                                'If Zust800 = False Then Print #3, StrAusgabe 
168.
                                Print #4, StrAusgabe 
169.
                                Exit For 
170.
                            End If 
171.
                            If Mid(StrAusgabe, n, 1) = "E" Then 
172.
                                'Gewicht wird auf NULL gesetzt 
173.
                                '<gewicht FIELDNAME="NFT_FLO0">8.4E-05</gewicht> 
174.
                                '123456789012345678901234567890 
175.
                                'If Zust800 = False Then Print #3, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
176.
                                Print #4, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
177.
                                Exit For 
178.
                            End If 
179.
                        Next n 
180.
                       Else 
181.
                        'If Zust800 = False Then Print #3, StrAusgabe 
182.
                        Print #4, StrAusgabe 
183.
                       End If 
184.
                        StrAusgabe = "" 
185.
                        Erkennen = False 
186.
                    End If 
187.
                End If 
188.
            Next i 
189.
        'f Zust800 = False Then Close #3 
190.
        Close #4 
191.
    End If 
192.
If Zust800 = False Then Shell "cmd /c copy " & Datei4 & " " & Datei3, vbHide 
193.
Exit Sub 
194.
EX: 
195.
Close #2 
196.
'Close #3 
197.
Close #4 
198.
End Sub 
199.
 
200.
Private Sub cmdChangeDir_Click() 
201.
        If SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" Then 
202.
            SourceDir(0) = Rechner & "\ErpInterface\ERPRequestResponse\" 
203.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequestResponse\" 
204.
        Else 
205.
            SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
206.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
207.
        End If 
208.
        lblSource(0).Caption = SourceDir(0) 
209.
        lblTarget(0).Caption = TargetDir(0) 
210.
        lstXMLalt(0).Clear 
211.
        lstXMLsource(0).Clear 
212.
        lstXMLtarget(0).Clear 
213.
End Sub 
214.
 
215.
Private Sub cmdDELA_Click(Index As Integer) 
216.
On Error GoTo EX 
217.
    If Index = 0 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
218.
    If Index = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
219.
    If Index = 2 Then Shell "cmd /c del /Q " & Erledigt(0) & "*.*", vbHide 
220.
    If Index = 3 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
221.
    If Index = 4 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
222.
    If Index = 5 Then Shell "cmd /c del /Q " & Erledigt(1) & "*.*", vbHide 
223.
Exit Sub 
224.
EX: 
225.
End Sub 
226.
 
227.
Private Sub cmdDELM_Click(Index As Integer) 
228.
    Dim i As Long 
229.
On Error GoTo EX 
230.
    If Index = 0 Then 
231.
        For i = 0 To lstXMLsource(0).ListCount - 1 
232.
            If lstXMLsource(0).Selected(i) Then 
233.
                lstXMLsource(0).RemoveItem (i) 
234.
                Shell "cmd /c del /Q " & SourceDir(0) & lstXMLsource(0).List(i) 
235.
                Exit For 
236.
            End If 
237.
        Next i 
238.
    End If 
239.
    If Index = 1 Then 
240.
        For i = 0 To lstXMLtarget(0).ListCount - 1 
241.
            If lstXMLtarget(0).Selected(i) Then 
242.
                lstXMLtarget(0).RemoveItem (i) 
243.
                Shell "cmd /c del /Q " & TargetDir(0) & lstXMLtarget(0).List(i) 
244.
                Exit For 
245.
            End If 
246.
        Next i 
247.
    End If 
248.
    If Index = 2 Then 
249.
        For i = 0 To lstXMLalt(0).ListCount - 1 
250.
            If lstXMLalt(0).Selected(i) Then 
251.
                lstXMLalt(0).RemoveItem (i) 
252.
                Shell "cmd /c del /Q " & Erledigt(0) & lstXMLalt(0).List(i) 
253.
                Exit For 
254.
            End If 
255.
        Next i 
256.
    End If 
257.
     
258.
    If Index = 3 Then 
259.
        For i = 0 To lstXMLsource(1).ListCount - 1 
260.
            If lstXMLsource(1).Selected(i) Then 
261.
                lstXMLsource(1).RemoveItem (i) 
262.
                Shell "cmd /c del /Q " & SourceDir(1) & lstXMLsource(1).List(i) 
263.
                Exit For 
264.
            End If 
265.
        Next i 
266.
    End If 
267.
    If Index = 4 Then 
268.
        For i = 0 To lstXMLtarget(1).ListCount - 1 
269.
            If lstXMLtarget(1).Selected(i) Then 
270.
                lstXMLtarget(1).RemoveItem (i) 
271.
                Shell "cmd /c del /Q " & TargetDir(1) & lstXMLtarget(1).List(i) 
272.
                Exit For 
273.
            End If 
274.
        Next i 
275.
    End If 
276.
    If Index = 5 Then 
277.
        For i = 0 To lstXMLalt(1).ListCount - 1 
278.
            If lstXMLalt(1).Selected(i) Then 
279.
                lstXMLalt(1).RemoveItem (i) 
280.
                Shell "cmd /c del /Q " & Erledigt(1) & lstXMLalt(1).List(i) 
281.
                Exit For 
282.
            End If 
283.
        Next i 
284.
    End If 
285.
Exit Sub 
286.
EX: 
287.
End Sub 
288.
 
289.
Private Sub Form_Unload(Cancel As Integer) 
290.
End 
291.
End Sub 
292.
 
293.
 Private Sub VerzeichnisseLoeschen() 
294.
 On Error GoTo EX 
295.
 If frmXML2CRLF.lstXMLsource(0).Text <> "" Then Shell "cmd /c del /Q " & frmXML2CRLF.lstXMLsource(0).Text, vbHide 
296.
 If frmXML2CRLF.lstXMLtarget(0).Text <> "" Then Shell "cmd /c del /Q " & frmXML2CRLF.lstXMLtarget(0).Text, vbHide 
297.
 If frmXML2CRLF.lstXMLsource(1).Text <> "" Then Shell "cmd /c del /Q " & frmXML2CRLF.lstXMLsource(1).Text, vbHide 
298.
 If frmXML2CRLF.lstXMLtarget(1).Text <> "" Then Shell "cmd /c del /Q " & frmXML2CRLF.lstXMLtarget(1).Text, vbHide 
299.
 
300.
 Exit Sub 
301.
EX: 
302.
 End Sub 
303.
  
304.
  
305.
 
306.
'Private Sub lstXMLalt_Click(Index As Integer) 
307.
'Dim i As Long 
308.
'Dim Datei As String 
309.
'Dim Info As String 
310.
'On Error GoTo EX 
311.
'If Index = 0 Then 
312.
'    For i = 0 To lstXMLalt(Index).ListCount - 1 
313.
'        If lstXMLalt(Index).Selected(i) Then 
314.
'            Datei = Left(lstXMLalt(Index).List(i), 40) 
315.
'            Datei = Erledigt(Index) & Datei 
316.
'        End If 
317.
'    Next i 
318.
'    Open Datei For Input As #2 
319.
'        Do While Not EOF(2)    'Schleife bis Dateiende. 
320.
'           Line Input #2, Info 
321.
'        Loop 
322.
'    Close #2 
323.
'End If 
324.
'Exit Sub 
325.
'EX: 
326.
'End Sub 
327.
 
328.
Private Sub lstXMLalt_DblClick(Index As Integer) 
329.
Dim i As Long 
330.
Dim Datei As String 
331.
On Error GoTo EX 
332.
For i = 0 To lstXMLalt(Index).ListCount - 1 
333.
    If lstXMLalt(Index).Selected(i) Then 
334.
        Datei = Left(lstXMLalt(Index).List(i), 40) 
335.
        ShellExecute Me.hWnd, "Open", Erledigt(Index) & Datei, "", App.Path, 1 
336.
    End If 
337.
Next i 
338.
Exit Sub 
339.
EX: 
340.
End Sub 
341.
 
342.
Private Sub lstXMLsource_dblClick(Index As Integer) 
343.
Dim i As Long 
344.
Dim Datei As String 
345.
On Error GoTo EX 
346.
For i = 0 To lstXMLsource(Index).ListCount - 1 
347.
    If lstXMLsource(Index).Selected(i) Then 
348.
        Datei = (Left(lstXMLsource(Index).List(i), 40)) 
349.
        'ShellExecute Me.hWnd, "Open", SourceDir(Index) & lstXMLsource(Index).List(i), "", App.Path, 1 
350.
        ShellExecute Me.hWnd, "Open", SourceDir(Index) & Datei, "", App.Path, 1 
351.
        'MsgBox (SourceDir(Index) & Datei) 
352.
    End If 
353.
Next i 
354.
Exit Sub 
355.
EX: 
356.
End Sub 
357.
 
358.
Private Sub lstXMLtarget_dblClick(Index As Integer) 
359.
Dim i As Long 
360.
Dim Datei As String 
361.
On Error GoTo EX 
362.
For i = 0 To lstXMLtarget(Index).ListCount - 1 
363.
    If lstXMLtarget(Index).Selected(i) Then 
364.
        Datei = Left(lstXMLtarget(Index).List(i), 40) 
365.
        ShellExecute Me.hWnd, "Open", TargetDir(Index) & Datei, "", App.Path, 1 
366.
    End If 
367.
Next i 
368.
Exit Sub 
369.
EX: 
370.
End Sub 
371.
 
372.
Private Sub tmrXML_Timer() 
373.
    VerzeichnisAuslesen 0 
374.
    If ViewModus = False Then VerzeichnisVergleichen 0 
375.
    VerzeichnisAuslesen 1 
376.
    If ViewModus = False Then VerzeichnisVergleichen 1 
377.
End Sub 
378.
 
379.
Private Sub Form_Load() 
380.
     
381.
    ViewModus = False 
382.
    Rechnername = Environ("COMPUTERNAME") 
383.
 
384.
    'Rechnername = "S18"      'Zum Testen um S18 vorzuspielen 
385.
    frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    Rechner: " & Rechnername 
386.
     
387.
    If Command() = "v" Or Command() = "V" Or Rechnername <> "S18" Then 
388.
        ViewModus = True 
389.
        MsgBox ("Das Programm läuft nur im View-Modus!") 
390.
        frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    ! View Modus !" 
391.
        Speed = 10000    'Timer 10 Sekunden 
392.
        txtSpeed.Text = Speed 
393.
    Else 
394.
        Speed = 2500    'Timer 2,5 Sekunden 
395.
        txtSpeed.Text = Speed 
396.
        If App.PrevInstance = True And Rechnername = "S18" Then 
397.
            'MsgBox ("Das Programm läuft nur im View-Modus!") 
398.
            End 
399.
        End If 
400.
    End If 
401.
     
402.
    Rechner = "C:"        'Zum Testen ohne Netz 
403.
    'Rechner = "\\S18"    'Echteinstellung 
404.
     
405.
    SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
406.
    TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
407.
    Erledigt(0) = Rechner & "\ErpInterface\OKRequest\" 
408.
    SourceDir(1) = Rechner & "\ErpInterface\ERPRequestResponse\" 
409.
    TargetDir(1) = Rechner & "\ErpInterface\TSRequestResponse\" 
410.
    Erledigt(1) = Rechner & "\ErpInterface\OKRequestResponse\" 
411.
     
412.
    lblSource(0).Caption = SourceDir(0) 
413.
    lblTarget(0).Caption = TargetDir(0) 
414.
    lblSource(1).Caption = SourceDir(1) 
415.
    lblTarget(1).Caption = TargetDir(1) 
416.
     
417.
'    If Command() = "d" Or Command() = "D" Or ViewModus = False Then 
418.
'        frmXML2CRLF.Visible = True 
419.
'        'VerzeichnisseLoeschen 
420.
'    End If 
421.
    tmrXML.Interval = Speed 
422.
 
423.
End Sub 
424.
 
Gruß
lordofremixes
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:22 Uhr
Zitat von bastla:
Hallo lordofremixes!

Wenn in der Listbox nicht "1" steht, ist es wenig sinnvoll, per "If" danach zu fragen - dann würde
sich eher etwas in der Art anbieten:
If frmXML2CRLF.lstXMLsource(0).Text <> "" Then Shell "cmd /c del /Q " 
> & frmXML2CRLF.lstXMLsource(0).Text, vbHide 
> 
Grüße
bastla

Macht Sinn!
Bitte warten ..
Mitglied: bastla
02.07.2012, aktualisiert um 19:29 Uhr
Hallo lordofremixes!

Soferne in der Listbox nur der Name der Datei steht, müsste auch noch der Pfad rein - etwa:
If frmXML2CRLF.lstXMLsource(0).Text <> "" Then Shell "cmd /c del /Q " & SourceDir(0) & frmXML2CRLF.lstXMLsource(0).Text, vbHide
- abgesehen davon sehe ich beim Überfliegen des Codes keinen Aufruf von "VerzeichnisseLoeschen()" ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:31 Uhr
Hallo bastla,

werd ich sofort ausprobieren.
Ganz unten , ausgeklammert?
Hab mich schon gefragt warum das ganz unten ausgeklammert steht..

Gruß
lordofremixes
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:39 Uhr
Hallo bastla,

Private Sub VerzeichnisseLoeschen()
Oder wird hier nur gesagt, dass es nur eine private Prozedur ist, die nur in dem Modul sichtbar ist, in dem sie steht?

Und wenn ja, wo muss der Aufruf dann stattfinden?

Gruß
lordofremixes
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 19:57 Uhr
Hallo bastla!

genauso angepasst, versucht einen Aufruf ganz unten im Programm "VerzeichnisseLoeschen()" zu machen, Name in Listbox noch da, und Verzeichnis auch noch voll...

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012 um 21:45 Uhr
Hallo lordofremixes!
versucht einen Aufruf ganz unten im Programm "VerzeichnisseLoeschen()" zu machen
Soferne Du die Zeile 419 meinst, müsste natürlich noch der Apostroph am Anfang weg ...
Name in Listbox noch da
Da es keine "DirListBox" ist (und auch die müsste aktualisiert werden), überrascht das auch nicht weiter - wie ein Entfernen aus der Liste geht, siehst Du im "Sub cmdDELM_Click" ...
Um zu testen, ob ein bestimmtes Sub überhaupt aufgerufen wird, kannst Du übrigens als einfachste Möglichkeit eine Zeile der Art
MsgBox "Bin jetzt im Sub xyz"
gleich am Anfang (nach "Sub ...") verwenden (soferne Du die Debugging-Möglichkeiten der IDE nicht kennst) ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012, aktualisiert um 22:00 Uhr
Hallo bastla,

den Aufruf habe ich unten gemacht. Es kommt Compile Error, Syntax Error..
genauso hab ichs drin:

....
01.
    Rechner = "C:"        'Zum Testen ohne Netz 
02.
    'Rechner = "\\S18"    'Echteinstellung 
03.
     
04.
    SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
05.
    TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
06.
    Erledigt(0) = Rechner & "\ErpInterface\OKRequest\" 
07.
    SourceDir(1) = Rechner & "\ErpInterface\ERPRequestResponse\" 
08.
    TargetDir(1) = Rechner & "\ErpInterface\TSRequestResponse\" 
09.
    Erledigt(1) = Rechner & "\ErpInterface\OKRequestResponse\" 
10.
     
11.
    lblSource(0).Caption = SourceDir(0) 
12.
    lblTarget(0).Caption = TargetDir(0) 
13.
    lblSource(1).Caption = SourceDir(1) 
14.
    lblTarget(1).Caption = TargetDir(1) 
15.
     
16.
 '   If Command() = "d" Or Command() = "D" Or ViewModus = False Then 
17.
'      frmXML2CRLF.Visible = True 
18.
  VerzeichnisseLoeschen() 
19.
 '   End If 
20.
 '   tmrXML.Interval = Speed 
21.
 
22.
End Sub 
23.
 
Dadurch kann ich auch den Aufruf MsgBox (in welchem Sub ich bin) nicht aufrufen.
Und muss ich, um die Dateien in der ListBox zu löschen so vorgehen:

01.
 
02.
Private Sub VerzeichnisseLoeschen(Index As Integer)  
03.
On Error GoTo EX  
04.
    If Index = 0 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide  
05.
    If Index = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide  
06.
    If Index = 2 Then Shell "cmd /c del /Q " & Erledigt(0) & "*.*", vbHide  
07.
    If Index = 3 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide  
08.
    If Index = 4 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide  
09.
    If Index = 5 Then Shell "cmd /c del /Q " & Erledigt(1) & "*.*", vbHide  
10.
 
11.
Exit Sub  
12.
EX:  
13.
End Sub 
?



Nochmal der ganze Code wie ich ihn jetzt gemacht hab:
01.
Option Explicit 
02.
'Dieses Programm fügt in eine einzeilige XML-Datei Zeileinumbrüche ein 
03.
 
04.
Dim Speed As Long 
05.
Dim Rechnername As String 
06.
Dim ViewModus As Boolean 
07.
Dim Rechner As String 
08.
Dim SourceDir(1) As String 
09.
Dim TargetDir(1) As String 
10.
Dim Erledigt(1) As String 
11.
 
12.
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As Any, ByVal lpParameters As Any, ByVal lpDirectory As Any, ByVal nShowCmd As Long) As Long 
13.
 
14.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long) 
15.
 
16.
Private Sub VerzeichnisAuslesen(i As Byte) 
17.
Dim v As Long 
18.
Dim cFile As String 
19.
    lstXMLsource(i).Clear 
20.
    v = 0 
21.
    cFile = Dir(SourceDir(i) & "*.XML") ' Alle Textdateien im Quellverzeichnis ausgeben 
22.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
23.
        lstXMLsource(i).AddItem (cFile) 
24.
        v = v + 1 
25.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
26.
    Loop 
27.
    lblSource(i).Caption = SourceDir(i) & " - " & lstXMLsource(i).ListCount & " Dateien" 
28.
    v = 0 
29.
    lstXMLtarget(i).Clear 
30.
    cFile = Dir(TargetDir(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
31.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
32.
        lstXMLtarget(i).AddItem (cFile) 
33.
        v = v + 1 
34.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
35.
    Loop 
36.
    lblTarget(i).Caption = TargetDir(i) & " - " & lstXMLtarget(i).ListCount & " Dateien" 
37.
    'lblAlt(i).Caption = "erledigt - " & lstXMLalt(i).ListCount & " Dateien" 
38.
    v = 0 
39.
    lstXMLalt(i).Clear 
40.
    cFile = Dir(Erledigt(i) & "*.XML") ' Alle Textdateien im Zielverzeichnis ausgeben 
41.
    Do While cFile <> "" And v < 1000 ' Wiederholen bis cFile="" 
42.
        lstXMLalt(i).AddItem (cFile) 
43.
        v = v + 1 
44.
        cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
45.
    Loop 
46.
    lblAlt(i).Caption = Erledigt(i) & " - " & lstXMLalt(i).ListCount & " Dateien" 
47.
     
48.
End Sub 
49.
 
50.
Private Sub VerzeichnisVergleichen(l As Byte) 
51.
Dim i As Long 
52.
Dim j As Long 
53.
Dim a As Long 
54.
Dim b As Long 
55.
Dim c As Long 
56.
Dim konvertiert As Boolean 
57.
 
58.
konvertiert = False 
59.
    For i = 0 To lstXMLsource(l).ListCount - 1 
60.
        a = lstXMLsource(l).ListCount - 1 
61.
        b = lstXMLalt(l).ListCount - 1 
62.
        If b - a < a Then 
63.
            c = 0 
64.
        Else 
65.
            c = b - a 
66.
        End If 
67.
        For j = c To lstXMLalt(l).ListCount - 1 
68.
            If lstXMLsource(l).List(i) = lstXMLalt(l).List(j) Then konvertiert = True 
69.
        Next j 
70.
        If konvertiert = False Then 
71.
            XML_umwandeln lstXMLsource(l).List(i), l 
72.
            konvertiert = False 
73.
        Else 
74.
            konvertiert = False 
75.
        End If 
76.
    Next i 
77.
End Sub 
78.
 
79.
Private Sub XML_umwandeln(XML_Datei As String, m As Byte) 
80.
Dim Datei2 As String 
81.
Dim Datei3 As String 
82.
Dim Datei4 As String 
83.
Dim Datei5 As String 
84.
Dim StrAusgabe As String 
85.
Dim StrA As String 
86.
Dim Erkennen As Boolean 
87.
Dim i As Long 
88.
Dim j As Long 
89.
Dim k As Byte 
90.
Dim l As Byte 
91.
Dim n As Byte 
92.
Dim Zust800 As Boolean 
93.
Dim Zeichen(10000000) As String 
94.
 
95.
On Error GoTo EX 
96.
    StrAusgabe = "" 
97.
    StrA = "" 
98.
    Datei2 = SourceDir(m) & XML_Datei 
99.
    Datei3 = TargetDir(m) & XML_Datei 
100.
    Datei4 = Erledigt(m) & XML_Datei 
101.
    Datei5 = "C:\ErpInterface\COP.bat" 
102.
    'lstXMLalt(m).AddItem (XML_Datei) 
103.
    i = 0 
104.
    Zust800 = False 
105.
    Open Datei2 For Input As #2 
106.
        Do While Not EOF(2)    'Schleife bis Dateiende. 
107.
           Line Input #2, Zeichen(i) 
108.
           i = i + 1 
109.
        Loop 
110.
    Close #2 
111.
 
112.
    If i > 1 Then               'Wenn XML-Datei aus mehr als einer Zeile besteht, wird sie so wieder ausgegeben 
113.
        'Open Datei3 For Output As #3 
114.
        Open Datei4 For Output As #4 
115.
            For j = 0 To i 
116.
                'Print #3, Zeichen(j) 
117.
                Print #4, Zeichen(j) 
118.
            Next j 
119.
        'Close #3 
120.
        Close #4 
121.
    Else 
122.
        j = Len(Zeichen(0)) 
123.
        If chk800.Value = 1 Then 
124.
            For i = 1 To j 
125.
                If Mid(Zeichen(0), i, 4) = "T" & Chr$(34) & ">8" Then 
126.
                    Zust800 = True 
127.
                End If 
128.
            Next i 
129.
        End If 
130.
        Erkennen = True         '=> Suche nach einem neunen Erkennung String "<XYZ " 
131.
        'If Zust800 = False Then Open Datei3 For Output As #3 
132.
        Open Datei4 For Output As #4 
133.
        If Zust800 = True Then 
134.
            Print #4, 
135.
            Print #4, 
136.
            Print #4, "<! ! ! ! !         Pruefmittel, nicht importiert              ! ! ! ! !>" 
137.
            Print #4, 
138.
            Print #4, 
139.
        End If 
140.
            For i = 1 To j 
141.
                StrAusgabe = StrAusgabe & Mid(Zeichen(0), i, 1) 
142.
                If Erkennen = True Then StrA = StrA & Mid(Zeichen(0), i, 1) 
143.
                If Mid(Zeichen(0), i, 1) = "<" Then 
144.
                    StrA = "" 
145.
                    Erkennen = True 
146.
                End If 
147.
                If Mid(Zeichen(0), i, 1) = " " Then 
148.
                    k = Len(StrA) 
149.
                    Erkennen = False 
150.
                End If 
151.
                If Erkennen = False And Mid(Zeichen(0), i, 1) = "<" And Mid(Zeichen(0), i, 2) <> "</" Then 
152.
                    Erkennen = True 
153.
                End If 
154.
      
155.
                If i > 5 Then 
156.
                    If Mid(Zeichen(0), i - 1, 2) = "?>" _ 
157.
                       Or Mid(Zeichen(0), i, 2) = "><" And Mid(Zeichen(0), i + 2, 1) <> "/" _ 
158.
                       Or (Mid(Zeichen(0), i, 1) = ">" And Erkennen = True) _ 
159.
                       And (Mid(Zeichen(0), i - 5, 6) <> "sCode>" And i > 11) _ 
160.
                       And (Mid(Zeichen(0), i - 5, 6) <> "ssage>" And i > 11) Then 
161.
                       If chkGew.Value = 1 And Left(StrAusgabe, 4) = "<gew" Then 
162.
                        For n = 30 To 40 
163.
                            If Mid(StrAusgabe, n, 1) = "<" Then 
164.
                                'alles ok, String kann ganz normal geschrieben werden 
165.
                                'If Zust800 = False Then Print #3, StrAusgabe 
166.
                                Print #4, StrAusgabe 
167.
                                Exit For 
168.
                            End If 
169.
                            If Mid(StrAusgabe, n, 1) = "E" Then 
170.
                                'Gewicht wird auf NULL gesetzt 
171.
                                '<gewicht FIELDNAME="NFT_FLO0">8.4E-05</gewicht> 
172.
                                '123456789012345678901234567890 
173.
                                'If Zust800 = False Then Print #3, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
174.
                                Print #4, "<gewicht FIELDNAME=" & Chr$(34) & "NFT_FLO0" & Chr$(34) & ">0</gewicht>" 
175.
                                Exit For 
176.
                            End If 
177.
                        Next n 
178.
                       Else 
179.
                        'If Zust800 = False Then Print #3, StrAusgabe 
180.
                        Print #4, StrAusgabe 
181.
                       End If 
182.
                        StrAusgabe = "" 
183.
                        Erkennen = False 
184.
                    End If 
185.
                End If 
186.
            Next i 
187.
        'f Zust800 = False Then Close #3 
188.
        Close #4 
189.
    End If 
190.
If Zust800 = False Then Shell "cmd /c copy " & Datei4 & " " & Datei3, vbHide 
191.
Exit Sub 
192.
EX: 
193.
Close #2 
194.
'Close #3 
195.
Close #4 
196.
End Sub 
197.
 
198.
Private Sub cmdChangeDir_Click() 
199.
        If SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" Then 
200.
            SourceDir(0) = Rechner & "\ErpInterface\ERPRequestResponse\" 
201.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequestResponse\" 
202.
        Else 
203.
            SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
204.
            TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
205.
        End If 
206.
        lblSource(0).Caption = SourceDir(0) 
207.
        lblTarget(0).Caption = TargetDir(0) 
208.
        lstXMLalt(0).Clear 
209.
        lstXMLsource(0).Clear 
210.
        lstXMLtarget(0).Clear 
211.
End Sub 
212.
 
213.
Private Sub cmdDELA_Click(Index As Integer) 
214.
On Error GoTo EX 
215.
    If Index = 0 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
216.
    If Index = 1 Then Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
217.
    If Index = 2 Then Shell "cmd /c del /Q " & Erledigt(0) & "*.*", vbHide 
218.
    If Index = 3 Then Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
219.
    If Index = 4 Then Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
220.
    If Index = 5 Then Shell "cmd /c del /Q " & Erledigt(1) & "*.*", vbHide 
221.
Exit Sub 
222.
EX: 
223.
End Sub 
224.
 
225.
Private Sub cmdDELM_Click(Index As Integer) 
226.
    Dim i As Long 
227.
On Error GoTo EX 
228.
    If Index = 0 Then 
229.
        For i = 0 To lstXMLsource(0).ListCount - 1 
230.
            If lstXMLsource(0).Selected(i) Then 
231.
                lstXMLsource(0).RemoveItem (i) 
232.
                Shell "cmd /c del /Q " & SourceDir(0) & lstXMLsource(0).List(i) 
233.
                Exit For 
234.
            End If 
235.
        Next i 
236.
    End If 
237.
    If Index = 1 Then 
238.
        For i = 0 To lstXMLtarget(0).ListCount - 1 
239.
            If lstXMLtarget(0).Selected(i) Then 
240.
                lstXMLtarget(0).RemoveItem (i) 
241.
                Shell "cmd /c del /Q " & TargetDir(0) & lstXMLtarget(0).List(i) 
242.
                Exit For 
243.
            End If 
244.
        Next i 
245.
    End If 
246.
    If Index = 2 Then 
247.
        For i = 0 To lstXMLalt(0).ListCount - 1 
248.
            If lstXMLalt(0).Selected(i) Then 
249.
                lstXMLalt(0).RemoveItem (i) 
250.
                Shell "cmd /c del /Q " & Erledigt(0) & lstXMLalt(0).List(i) 
251.
                Exit For 
252.
            End If 
253.
        Next i 
254.
    End If 
255.
     
256.
    If Index = 3 Then 
257.
        For i = 0 To lstXMLsource(1).ListCount - 1 
258.
            If lstXMLsource(1).Selected(i) Then 
259.
                lstXMLsource(1).RemoveItem (i) 
260.
                Shell "cmd /c del /Q " & SourceDir(1) & lstXMLsource(1).List(i) 
261.
                Exit For 
262.
            End If 
263.
        Next i 
264.
    End If 
265.
    If Index = 4 Then 
266.
        For i = 0 To lstXMLtarget(1).ListCount - 1 
267.
            If lstXMLtarget(1).Selected(i) Then 
268.
                lstXMLtarget(1).RemoveItem (i) 
269.
                Shell "cmd /c del /Q " & TargetDir(1) & lstXMLtarget(1).List(i) 
270.
                Exit For 
271.
            End If 
272.
        Next i 
273.
    End If 
274.
    If Index = 5 Then 
275.
        For i = 0 To lstXMLalt(1).ListCount - 1 
276.
            If lstXMLalt(1).Selected(i) Then 
277.
                lstXMLalt(1).RemoveItem (i) 
278.
                Shell "cmd /c del /Q " & Erledigt(1) & lstXMLalt(1).List(i) 
279.
                Exit For 
280.
            End If 
281.
        Next i 
282.
    End If 
283.
Exit Sub 
284.
EX: 
285.
End Sub 
286.
 
287.
Private Sub Form_Unload(Cancel As Integer) 
288.
End 
289.
End Sub 
290.
 
291.
 Private Sub VerzeichnisseLoeschen() 
292.
 On Error GoTo EX 
293.
 If frmXML2CRLF.lstXMLsource(0).Text <> "" Then Shell "cmd /c del /Q " & SourceDir(0) & frmXML2CRLF.lstXMLsource(0).Text, vbHide 
294.
 
295.
 Exit Sub 
296.
EX: 
297.
 End Sub 
298.
  
299.
  
300.
 
301.
'Private Sub lstXMLalt_Click(Index As Integer) 
302.
'Dim i As Long 
303.
'Dim Datei As String 
304.
'Dim Info As String 
305.
'On Error GoTo EX 
306.
'If Index = 0 Then 
307.
'    For i = 0 To lstXMLalt(Index).ListCount - 1 
308.
'        If lstXMLalt(Index).Selected(i) Then 
309.
'            Datei = Left(lstXMLalt(Index).List(i), 40) 
310.
'            Datei = Erledigt(Index) & Datei 
311.
'        End If 
312.
'    Next i 
313.
'    Open Datei For Input As #2 
314.
'        Do While Not EOF(2)    'Schleife bis Dateiende. 
315.
'           Line Input #2, Info 
316.
'        Loop 
317.
'    Close #2 
318.
'End If 
319.
'Exit Sub 
320.
'EX: 
321.
'End Sub 
322.
 
323.
Private Sub lstXMLalt_DblClick(Index As Integer) 
324.
Dim i As Long 
325.
Dim Datei As String 
326.
On Error GoTo EX 
327.
For i = 0 To lstXMLalt(Index).ListCount - 1 
328.
    If lstXMLalt(Index).Selected(i) Then 
329.
        Datei = Left(lstXMLalt(Index).List(i), 40) 
330.
        ShellExecute Me.hWnd, "Open", Erledigt(Index) & Datei, "", App.Path, 1 
331.
    End If 
332.
Next i 
333.
Exit Sub 
334.
EX: 
335.
End Sub 
336.
 
337.
Private Sub lstXMLsource_dblClick(Index As Integer) 
338.
Dim i As Long 
339.
Dim Datei As String 
340.
On Error GoTo EX 
341.
For i = 0 To lstXMLsource(Index).ListCount - 1 
342.
    If lstXMLsource(Index).Selected(i) Then 
343.
        Datei = (Left(lstXMLsource(Index).List(i), 40)) 
344.
        'ShellExecute Me.hWnd, "Open", SourceDir(Index) & lstXMLsource(Index).List(i), "", App.Path, 1 
345.
        ShellExecute Me.hWnd, "Open", SourceDir(Index) & Datei, "", App.Path, 1 
346.
        'MsgBox (SourceDir(Index) & Datei) 
347.
    End If 
348.
Next i 
349.
Exit Sub 
350.
EX: 
351.
End Sub 
352.
 
353.
Private Sub lstXMLtarget_dblClick(Index As Integer) 
354.
Dim i As Long 
355.
Dim Datei As String 
356.
On Error GoTo EX 
357.
For i = 0 To lstXMLtarget(Index).ListCount - 1 
358.
    If lstXMLtarget(Index).Selected(i) Then 
359.
        Datei = Left(lstXMLtarget(Index).List(i), 40) 
360.
        ShellExecute Me.hWnd, "Open", TargetDir(Index) & Datei, "", App.Path, 1 
361.
    End If 
362.
Next i 
363.
Exit Sub 
364.
EX: 
365.
End Sub 
366.
 
367.
Private Sub tmrXML_Timer() 
368.
    VerzeichnisAuslesen 0 
369.
    If ViewModus = False Then VerzeichnisVergleichen 0 
370.
    VerzeichnisAuslesen 1 
371.
    If ViewModus = False Then VerzeichnisVergleichen 1 
372.
End Sub 
373.
 
374.
Private Sub Form_Load() 
375.
     
376.
    ViewModus = False 
377.
    Rechnername = Environ("COMPUTERNAME") 
378.
 
379.
    'Rechnername = "S18"      'Zum Testen um S18 vorzuspielen 
380.
    frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    Rechner: " & Rechnername 
381.
     
382.
    If Command() = "v" Or Command() = "V" Or Rechnername <> "S18" Then 
383.
        ViewModus = True 
384.
        MsgBox ("Das Programm läuft nur im View-Modus!") 
385.
        frmXML2CRLF.Caption = frmXML2CRLF.Caption & "    ! View Modus !" 
386.
        Speed = 10000    'Timer 10 Sekunden 
387.
        txtSpeed.Text = Speed 
388.
    Else 
389.
        Speed = 2500    'Timer 2,5 Sekunden 
390.
        txtSpeed.Text = Speed 
391.
        If App.PrevInstance = True And Rechnername = "S18" Then 
392.
            'MsgBox ("Das Programm läuft nur im View-Modus!") 
393.
            End 
394.
        End If 
395.
    End If 
396.
     
397.
    Rechner = "C:"        'Zum Testen ohne Netz 
398.
    'Rechner = "\\S18"    'Echteinstellung 
399.
     
400.
    SourceDir(0) = Rechner & "\ErpInterface\PDMRequest\" 
401.
    TargetDir(0) = Rechner & "\ErpInterface\TSRequest\" 
402.
    Erledigt(0) = Rechner & "\ErpInterface\OKRequest\" 
403.
    SourceDir(1) = Rechner & "\ErpInterface\ERPRequestResponse\" 
404.
    TargetDir(1) = Rechner & "\ErpInterface\TSRequestResponse\" 
405.
    Erledigt(1) = Rechner & "\ErpInterface\OKRequestResponse\" 
406.
     
407.
    lblSource(0).Caption = SourceDir(0) 
408.
    lblTarget(0).Caption = TargetDir(0) 
409.
    lblSource(1).Caption = SourceDir(1) 
410.
    lblTarget(1).Caption = TargetDir(1) 
411.
     
412.
 '   If Command() = "d" Or Command() = "D" Or ViewModus = False Then 
413.
'      frmXML2CRLF.Visible = True 
414.
  VerzeichnisseLoeschen() 
415.
 '   End If 
416.
 '   tmrXML.Interval = Speed 
417.
 
418.
End Sub 
419.
 
420.
 

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012, aktualisiert um 22:16 Uhr
Hallo lordofremixes!

Lass beim Aufruf die Klammern weg ...
Und muss ich, um die Dateien in der ListBox zu löschen so vorgehen:
Ich hatte "Sub cmdDELM_Click" geschrieben - dort ist die Zeile
lstXMLsource(0).RemoveItem (i)
für das Entfernen des Eintrags aus der ListBox zuständig, wobei der aktuell gewählte Eintrag per
lstXMLsource(0).RemoveItem(ListIndex)
zu entfernen wäre (siehe dazu zB die Übersicht in Using ListBox and ComboBox Controls In Visual Basic 6) ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 22:17 Uhr
Hallo bastla,

heißt das ich benötige einen Sub für das Löschen der Listboxeinträge und einen für das Löschen der Dateien im Verzeichnis?
Und wieso muss das per Click Befehl gemacht werden? Das soll doch automatisch stattfinden, wenn die Dateien abgearbeitet sind?

Ich blick grad nichts mehr heißt das den befehl lstXMLsource(0).RemoveItem (i) unter
Private Sub VerzeichnisseLoeschen()
On Error GoTo EX
lstXMLsource(0).RemoveItem (i)

Exit Sub
EX:
End Sub

Sorry dass ich so dooof bin!

Gruß
lordofremixes
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 22:19 Uhr
Ich hab den Code jetzt so oft geändert, dass er glaub vorne und hinten nicht mehr stimmt.
Macht es was aus, wenn ich ihn wieder so öffne, dass er so wie vor ca. 6 Stunden war?
Oder ist dann die ganze Arbeit (wenn man das so nennen kann) dahin?
Bitte warten ..
Mitglied: bastla
02.07.2012 um 22:23 Uhr
Hallo lordofremixes!
Macht es was aus, wenn ich ihn wieder so öffne, dass er so wie vor ca. 6 Stunden war?
Im Gegenteil - eigentlich ging es in der Ausgangsversion ja darum, ganze Ordnerinhalte (wenn die entsprechende CheckBox im inzwischen fehlenden Formular aktiviert war) zu löschen - insofern sollte es ja, wenn das Programm ansonsten funktioniert, tatsächlich genügen, wie schon am Anfang vorgeschlagen, die Auswertung dieser CheckBoxes einfach wegzulassen ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 22:25 Uhr
Lass beim Aufruf die Klammern weg ...
Das Kompilieren hat geklappt!!

Gruß
lordofremixes
Bitte warten ..
Mitglied: bastla
02.07.2012, aktualisiert um 22:31 Uhr
Hallo lordofremixes!

Nochmals der Hinweis: "VerzeichnisseLoeschen" ist eigentlich gedacht, den Inhalt ganzer Ordner zu löschen - insofern solltest Du es nochmals mit der Ausgangsversion versuchen und ggf einfach anstatt
If frmDelDir.chkDEL(0).Value = 1 Then Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide
nur
Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide
schreiben - das Löschen einzelner Dateien sollte durch "cmdDELM_Click" erledigt werden ...

Grüße
bastla
Bitte warten ..
Mitglied: lordofremixes
02.07.2012 um 22:39 Uhr
Hallo bastla,

genauso gemacht , also alles resettet, Programm läuft wieder.

Also wie heute schon einmal probiert, den Code ersetzt:
01.
Private Sub VerzeichnisseLoeschen() 
02.
 On Error GoTo EX 
03.
 Shell "cmd /c del /Q " & SourceDir(0) & "*.*", vbHide 
04.
 Shell "cmd /c del /Q " & TargetDir(0) & "*.*", vbHide 
05.
 Shell "cmd /c del /Q " & SourceDir(1) & "*.*", vbHide 
06.
 Shell "cmd /c del /Q " & TargetDir(1) & "*.*", vbHide 
07.
 
08.
 Exit Sub 
09.
EX: 
10.
 End Sub
und unten im Programm
VerzeichnisseLoeschen

Ergebnis:
Programm wandelt die xml Datei um, aber im Verzeichnis wird nichts gelöscht und in der Listbox steht sie auch noch drin.

Gruß
lordofremixes
Bitte warten ..
Mitglied: delemming
09.07.2012 um 09:57 Uhr
Nix für ungut, aber was für nen Krampf tust du dir hier gerade eigentlich an?
die VB-Api bietet eigenene Befehle fürs löschen an. such mal nach FSO(filesystemobjects)

http://www.freevbcode.com/ShowCode.asp?ID=1155
Bitte warten ..
Neuester Wissensbeitrag
Ähnliche Inhalte
Batch & Shell
gelöst Powershell - In Textdatei suchen und ersetzen (5)

Frage von Raaja89 zum Thema Batch & Shell ...

Windows Netzwerk
Windows Server 2003 SBS Netzwerk durch neuen Server Ersetzen (9)

Frage von MultiStorm zum Thema Windows Netzwerk ...

Batch & Shell
gelöst Suchen und Ersetzen mehrerer Suchbegriffe per Batch (4)

Frage von makroll10 zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (33)

Frage von patz223 zum Thema Windows Userverwaltung ...

LAN, WAN, Wireless
FritzBox, zwei Server, verschiedene Netze (21)

Frage von DavidGl zum Thema LAN, WAN, Wireless ...

Viren und Trojaner
Aufgepasst: Neue Ransomware Goldeneye verbreitet sich rasant (20)

Link von Penny.Cilin zum Thema Viren und Trojaner ...