sukumar
12-05-2016, 08:34 AM
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
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