Hallo, ich versuche mich gerade an folgender Aufgabenstellung: Alle .csv Datein eines ausgewaehlten Ordners oeffnen und dann das dann nach XXXProgramXXstartsXXXX startende Programm abspulen fuer jede Datei. Danach die Datein nicht schliessen oder speichern. Leider bekomme ich keinen runtime error (1004). Hat jemand eine Idee? Meine VBA-Kenntnisse sind leider noch sehr uebersichtlich. Vielen Dank!
<div>
Sub LoopAllExcelFilesInFolder()</div><div>
</div><div>Dim wb As Workbook</div><div>Dim myPath As String</div><div>Dim myFile As String</div><div>Dim myExtension As String</div><div>Dim FldrPicker As FileDialog</div><div>
</div><div>'Optimize Macro Speed</div><div> Application.ScreenUpdating = False</div><div> Application.EnableEvents = False</div><div> Application.Calculation = xlCalculationManual</div><div>
</div><div>'Retrieve Target Folder Path From User</div><div> Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)</div><div>
</div><div> With FldrPicker</div><div> .Title = "Select A Target Folder"</div><div> .AllowMultiSelect = False</div><div> If .Show <> -1 Then GoTo NextCode</div><div> myPath = .SelectedItems(1) & "\"</div><div> End With</div><div>
</div><div>'In Case of Cancel</div><div>NextCode:</div><div> myPath = myPath</div><div> If myPath = "" Then GoTo ResetSettings</div><div>
</div><div>'Target File Extension (must include wildcard "*")</div><div> myExtension = "*.csv"</div><div>
</div><div>'Target Path with Ending Extention</div><div> myFile = Dir(myPath & myExtension)</div><div>
</div><div>'Loop through each Excel file in folder</div><div> Do While myFile <> ""</div><div> 'Set variable equal to opened workbook</div><div> Set wb = Workbooks.Open(Filename:=myPath & myFile)</div><div> </div><div>'XXXXXXXXXXXXXXXXXXXXProgramXXstartsXXXXXXXXXXXXXXXXXXXXXXXXX</div><div>Dim i As Integer</div><div>Dim j</div><div>
</div><div>i = 0</div><div>j = 0</div><div>
</div><div> Columns("A:A").Select</div><div> Application.CutCopyMode = False</div><div> Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _</div><div> TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _</div><div> Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _</div><div> :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True</div><div>
</div><div>For i = 19 To 522</div><div>
</div><div>
</div><div> ' If Then</div><div> ' Rows(i).Delete</div><div> ' End If</div><div>
</div><div> If Cells(i, 4).Value >= Cells(i, 5).Value And Cells(i, 4).Value <= Cells(i, 6).Value Or Cells(i, 4).Value = "0" Or Cells(i, 7).Value = "-" Or Cells(i, 7).Value = "mm" Or Cells(i, 4).Value = "Value" Or Cells(i, 7).Value = "mbar" Or Cells(i, 7).Value = "Grad" Or Cells(i, 7).Value = "ccm/min" Or Cells(i, 6).Value = "" Or Cells(i, 5).Value = "" Or Cells(i, 2).Value = "OP1200OS" Or Cells(i, 2).Value = "OP1200CS" Then</div><div> 'Range(Cells(i, 1), Cells(i, 8)).Interior.Color = RGB(0, 255, 0)</div><div> Rows(i).Delete</div><div> ' Or Cells(i, 4).Value = "1.3" Or Cells(i, 6).Value = "" Or Cells(i, 5).Value = "" Or Cells(i, 7).Value = "kN" Or Cells(i, 7).Value = "Nm"</div><div> </div><div> Else</div><div> </div><div> </div><div> Range(Cells(i, 1), Cells(i, 8)).Interior.Color = RGB(255, 0, 0)</div><div> i = i + 1</div><div> </div><div> </div><div> End If</div><div> </div><div> i = i - 1</div><div> </div><div> ' If Range(Cells(i, 1), Cells(i, 8)).Interior.Color = RGB(0, 255, 0) Or Cells(i, 5).Value = "" Or Cells(i, 6).Value = "" Or Cells(i, 7).Value = "-" Or Cells(i, 4).Value = "Value" Then</div><div> '</div><div> ' End If</div><div> </div><div> j = Cells(i, 1).Value</div><div> </div><div> If j = "time" Then Exit Sub</div><div> If j = 0 Then Exit Sub</div><div> </div><div> </div><div>Next i</div><div>
</div><div>'XXXXXXXXXXXXXXXXXXXXProgramXXendsXXXXXXXXXXXXXXXXXXXXXXXXX</div><div>
</div><div> 'Get next file name</div><div> myFile = Dir</div><div> Loop</div><div>
</div><div>'Message Box when tasks are completed</div><div> MsgBox "Task Complete!"</div><div>
</div><div>ResetSettings:</div><div> 'Reset Macro Optimization Settings</div><div> Application.EnableEvents = True</div><div> Application.Calculation = xlCalculationAutomatic</div><div> Application.ScreenUpdating = True</div><div>
</div><div>End Sub</div><div>
</div>
|