Convert to For Next loop

[sukumar]

I am looking to convert this picking up of csv files into For ... Next or Do ... while or DO ... until loop: -

Is this possible?




Private Sub Workbook_Open()
On Error Resume Next

Dim intChoice As Integer
Dim strPath As String
Dim disbox As FileDialog

ActiveSheet.Name = "FileLog"
Sheets("FileLog").Select

Set disbox = Application.FileDialog(msoFileDialogFilePicker)

With disbox

.Title = "A Report" 'just changing title of Dialog Box

.AllowMultiSelect = False 'only allow the user to select one file

.InitialView = msoFileDialogViewDetails

.Filters.Clear

.Filters.Add "XYZ Reasons", "*.csv"

ActiveSheet.Cells(1, 1) = disbox.Title
intChoice = disbox.Show 'make the file dialog visible to the user


If intChoice <> 0 Then 'determine what choice the user made

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'get the file path selected by the user

ActiveSheet.Cells(1, 2) = strPath 'print the file path to sheet 1

Else

MsgBox "You have not selected..." & vbCrLf & vbCrLf & "A Report !", vbCritical, "Address Required ... "
ActiveSheet.Cells(1, 2) = "Address_Absent"
Exit Sub

End If



End With

With disbox

.Title = "D Report" 'just changing title of Dialog Box

.AllowMultiSelect = False 'only allow the user to select one file

.InitialView = msoFileDialogViewDetails

.Filters.Clear

.Filters.Add "D", "*.csv"

ActiveSheet.Cells(2, 1) = disbox.Title

intChoice = disbox.Show 'make the file dialog visible to the user

If intChoice <> 0 Then 'determine what choice the user made

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'get the file path selected by the user


ActiveSheet.Cells(2, 2) = strPath 'print the file path to sheet 1

Else

MsgBox "You have not selected ..." & vbCrLf & vbCrLf & "D Report !", vbCritical, "Address Required ... "
ActiveSheet.Cells(2, 2) = "Address_Absent"
Exit Sub

End If

End With

With disbox

.Title = "E M Detabes" 'just changing title of Dialog Box

.AllowMultiSelect = False 'only allow the user to select one file

.InitialView = msoFileDialogViewDetails

.Filters.Clear

.Filters.Add "E", "*.csv"

intChoice = disbox.Show 'make the file dialog visible to the user

ActiveSheet.Cells(3, 1) = disbox.Title

If intChoice <> 0 Then 'determine what choice the user made

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'get the file path selected by the user

ActiveSheet.Cells(3, 2) = strPath 'print the file path to sheet 1

Else

MsgBox "You have not selected ..." & vbCrLf & vbCrLf & "E M !", vbCritical, "Address Required ... "
ActiveSheet.Cells(3, 2) = "Address_Absent"
Exit Sub

End If

End With

With disbox

.Title = "A S DETAILS" 'just changing title of Dialog Box

.AllowMultiSelect = False 'only allow the user to select one file

.InitialView = msoFileDialogViewDetails

.Filters.Clear

.Filters.Add "S Details", "*.csv"

ActiveSheet.Cells(4, 1) = disbox.Title

intChoice = disbox.Show 'make the file dialog visible to the user

If intChoice <> 0 Then 'determine what choice the user made

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'get the file path selected by the user

ActiveSheet.Cells(4, 2) = strPath 'print the file path to sheet 1

Else

MsgBox "You have not selected..." & vbCrLf & vbCrLf & "A S DETAILS !", vbCritical, "Address Required ... "
ActiveSheet.Cells(4, 2) = "Address_Absent"
'Exit Sub

End If

End With

Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(1, 1).Select

'import XYZ reasons
strPath = Sheets("FileLog").Cells(1, 2).Value

ActiveSheet.Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "processed"
Sheets("processed").Select

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPath, Destination:=Range("$A$1"))
' .CommandType = 0
.Name = "a"
.FieldNames = True
.RowNumbers = True
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'import e m detabes
strPath = Sheets("FileLog").Cells(3, 2).Value

ActiveSheet.Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "em"
Sheets("employee").Select

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPath, Destination:=Range("$A$1"))
'.CommandType = 0
.Name = "em"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With

' import d deta

strPath = Sheets("FileLog").Cells(2, 2).Value

ActiveSheet.Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "d"
Sheets("d").Select

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPath, Destination:=Range("$A$1"))
'.CommandType = 0
.Name = "d"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With

Application.DisplayAlerts = False
Sheets("FileLog").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


Dim EMS As Worksheet
Set EMS = ThisWorkbook.Worksheets("e")
' operations to happen over E sheet ... first operation

EMS.Select
Columns("A:A").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Cells(1, 1).Select ' You can "activate" only one object, but "select" many objects.

Set EMS = Nothing
Set disbox = Nothing

End Sub







With thanks,
Sukumar

[p45cal]

Try the following (untested).
Two small differences: the order of sheets will be different, one alert message is slightly different.
You had an On Error Resume Next statement which will have been masking several errors - I've made comments in the code where I think things might have gone awry.

Private Sub Workbook_Open()
'On Error Resume Next
Dim intChoice As Integer
Dim strPath As String
Dim disbox As FileDialog
ActiveSheet.Name = "FileLog" 'this is a bit dodgy because you have to hope the file was last saved with the right sheet being the active sheet.
'Sheets("FileLog").Select
Set disbox = Application.FileDialog(msoFileDialogFilePicker)
Titles = Array("A Report", "D Report", "E M Detabes", "A S DETAILS")
myFilters = Array("XYZ Reasons", "D", "E", "S Details")

With disbox
For rw = 1 To 4
.Title = Titles(rw) 'just changing title of Dialog Box
.AllowMultiSelect = False 'only allow the user to select one file
.InitialView = msoFileDialogViewDetails
.Filters.Clear
.Filters.Add myFilters(rw), "*.csv"
ActiveSheet.Cells(rw, 1) = Titles(rw)
intChoice = disbox.Show 'make the file dialog visible to the user
If intChoice <> 0 Then 'determine what choice the user made
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 'get the file path selected by the user
ActiveSheet.Cells(rw, 2) = strPath 'print the file path to sheet 1
Else
MsgBox "You have not selected..." & vbCrLf & vbCrLf & Titles(rw) & "!", vbCritical, "Address Required ... "
ActiveSheet.Cells(rw, 2) = "Address_Absent"
Exit Sub
End If
Next rw
End With

'The following 4 lines are probably unnecessary since the sheet is going to be deleted anyway.
'Cells.EntireColumn.AutoFit
'Columns("A:A").HorizontalAlignment = xlRight
'Columns("B:B").HorizontalAlignment = xlLeft
'Cells(1, 1).Select

TableNames = Array("processed", "d", "em")
SheetNames = Array("a", "d", "em") 'Array("a", "d", "emloyee") 'not sure which is correct.
myRowNumbers = Array(True, False, False) 'did you mean to have RowNumbers=True for the 'processed' sheet?

For rw = 1 To 3
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetNames(rw)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Sheets("FileLog").Cells(rw, 2).Value, Destination:=Range("$A$1"))
.Name = TableNames(rw)
.RowNumbers = myRowNumbers(rw) '<<<<<<<<<<<< did you mean to have RowNumbers=True for the 'processed' sheet?
.FillAdjacentFormulas = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = 0
.TextFilePlatform = 437
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next rw

Application.DisplayAlerts = False
Sheets("FileLog").Delete
Application.DisplayAlerts = True
With ThisWorkbook.Worksheets("e") 'is there such a worksheet?
' operations to happen over E sheet ... first operation
.Columns("A:A").Cut
.Columns("D:D").Insert
End With
End Sub