read all the files after choosing a directory

[M H]

I have the following sub for a button ob a custom userform to get a
folder name:

Private Sub cmdChooseDir_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please choose a directory _
containing your data files."
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Please re-enter."
Else
lblDirectory.Caption = .SelectedItems(1)
End If
End With
End Sub

and I have a sub in a module to import the files and save them as excel
files automatically:

Public Sub AutomateDataImport()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Data"
.SearchSubFolders = True
.FileName = "*.txt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For I = 1 To .FoundFiles.Count
Application.DisplayAlerts = False
Opentxt = .FoundFiles(I)
Workbooks.OpenText FileName:=FNameImport, _
DataType:=xlDelimited, Tab:=True
ActiveWorkbook.SaveAs Opentxt, xlNormal
Next I
End With
End Sub

How could I pass the directory obtained from sub#1 to sub#2's .lookin
object for importing all the files within?

Thanks.
Maurice

 

[Bob Phillips]

Private Sub cmdChooseDir_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please choose a directory _
containing your data files."
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Please re-enter."
Else
lblDirectory.Caption = .SelectedItems(1)
AutomateDataImport = .SelectedItems(1)
End If
End With
End Sub

Public Sub AutomateDataImport(folder As String)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = folder .SearchSubFolders = True
.FileName = "*.txt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For I = 1 To .FoundFiles.Count
Application.DisplayAlerts = False
Opentxt = .FoundFiles(I)
Workbooks.OpenText FileName:=FNameImport, _
DataType:=xlDelimited, Tab:=True
ActiveWorkbook.SaveAs Opentxt, xlNormal
Next I
End With
End Sub

 

[M H]

Hi Bob,

Much thanks for teaching me passing the variable between subroutines.
But the problem is actually a bit more complicated, as follows. After
getting the directory, it has to pass to the OK button for action and
then the AutomateDataImport sub through the lblDirectory.Caption, but
seems not working as what I've written below. Please advice.


Private Sub cmdChooseDir_Click()
Dim AutomateDataImport As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please choose a directory containing your data files."
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Please re-enter."
Else
lblDirectory.Caption = .SelectedItems(1)
End If
End With
End Sub

Private Sub cmdOK_Click()

If lblDirectory.Caption <> "" Then

ActiveWorkbook.Sheets("Data Summary").Activate
Range("C2").Select

ActiveCell.Value = cboCellLine.Value
ActiveCell.Offset(1, 0) = cboStandard.Value
ActiveCell.Offset(2, 0) = cboPosCtrl.Value
lblDirectory.Caption = FolderSelected

Unload Me
Else
With lblWarnMsgBox
.Caption = "Data Missing!"
.ForeColor = RGB(255, 0, 0)
End With
Range("C2").Select
End If

Call AutomateDataImport(FolderSelected)
End Sub

Public Sub AutomateDataImport(folder As String)
Dim StartTime
Dim Timemsg As String
Dim I As Integer
Dim Opentxt, Savetxt, dot As String

StartTime = Now
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = folder
.SearchSubFolders = True
.FileName = "*.txt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For I = 1 To .FoundFiles.Count
Application.DisplayAlerts = False
Opentxt = .FoundFiles(I)
Workbooks.OpenText FileName:=FNameImport, _
DataType:=xlDelimited, Tab:=True
dot = InStr(1, Opentxt, ".")
Savetxt = Mid(Opentxt, 1, dot - 1)
ActiveWorkbook.SaveAs Savetxt, xlNormal
Next I
End With
Timemsg = "Processing time: " & _
Round((Now - StartTime) * 24 * 60 * 60, 2)
MsgBox "All files that were found have now been saved as Excel
files." _
& vbCr & Timemsg & " Second(s)"

End Sub

 

[Bob Phillips]

What exactly does '... it has to pass to the OK button for action and
then the AutomateDataImport sub through the lblDirectory.Caption...
mean?

Is the AutomateDataImport sub in the userform or a standard code module?

 

[M H]

Sorry for the confusion. The two cmd buttons are on a custom userform,
in which in this case the folder variable is passed from
cmdChooseDir_Click to cmdOK_Click to take the actions within.
AutomateFileImport is separately on a standard code module with others
subs.

BTW, the variable FNameImport within AutomateFileImport sub as listed
before should be Opentxt.

 

[M H]

I have solved the problem actually with some adjustment to the codes,
but sacrificing the cmdChooseDir button on the useform, which actually
may not be necessary. Thanks so much for inspirations again, and even
much appreciated for this helpful newsgroup. Here I meet all real MVPs!

Share with you the codes below:

Private Sub cmdOK_Click()

If cboCellLine.Value <> "" _
And cboStandard.Value <> "" _
And cboPosCtrl.Value <> "" _
Then
ActiveWorkbook.Sheets("Data Summary").Activate
Range("C2").Select
ActiveCell.Value = cboCellLine.Value
ActiveCell.Offset(1, 0) = cboStandard.Value
ActiveCell.Offset(2, 0) = cboPosCtrl.Value
Unload Me
Else
With lblWarnMsgBox
.Caption = "Data Missing!"
.ForeColor = RGB(255, 0, 0)
End With
Range("C2").Select
End If
Call AutomateDataImport
End Sub

Public Sub AutomateDataImport()
Dim StartTime
Dim Timemsg As String
Dim I As Integer
Dim Opentxt, Savetxt, dot, folder As String

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please choose a directory containing your data files."
.Show
folder = .SelectedItems(1)
End With

StartTime = Now
Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.LookIn = folder
.SearchSubFolders = True
.FileName = "*.squ"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
End If
For I = 1 To .FoundFiles.Count
Application.DisplayAlerts = False
Opentxt = .FoundFiles(I)
Workbooks.OpenText FileName:=Opentxt, _
DataType:=xlDelimited, Tab:=True
ActiveSheet.Range("A1:CW91").Copy _
Destination:=Assay96Template.Sheets("Raw
Data").Range("A1")
Assay96Template.Charts("MiniCharts").Activate
'Chart1.Activate
FormatMiniChartsAgain
dot = InStr(1, Opentxt, ".")
Savetxt = Mid(Opentxt, 1, dot - 1)
ActiveWorkbook.SaveAs Savetxt, xlNormal
CloseAllInactiveWB2
Next I
End With
Timemsg = "Processing time: " & _
Round((Now - StartTime) * 24 * 60, 2)
MsgBox "All files that were found have now been saved as Excel
files." _
& vbCr & Timemsg & " Minute(s)"

End Sub

b/rgds,
Maurice