Hello everyone,
I'm trying to make an upgrade to my code, but I have no idea how to do this with other dependencies to this code.
The code now works like this:
Choose Folder and in this folder grab all files with extension .par.
Each imported .par file is on its own sheet and the name of the sheet is name of imported file. (Example: Name is Test.par and sheet name is the same - Test.par) Problem is with long names of the files.
I need to be able to choose the order of the files (Like an array), just to click on them in order of importing to the sheets. (Sub process is using the order of sheets).
Next problem is with the long names of files.
- I need to import the name (for example) to Cell 1,1.
- Another sub process is searching for cells on this sheets and I need to be able to refer to the name of the sheet.
Example: I'm searching for cell value "Car", the process find the cell value "Car" on sheet "Toys" and I need to do something like this - FindedCell.Worksheet.Cells(1,1).Value
The result of this should be, that FindedCell is on sheet "Toys".
I tried to do the best description, which I could.:duck:
Thank you a lot for every help!
Here is code for import all .par files in folder:
Private Sub ChooseFolder_Click()
Dim xStrPath As String
Dim xFileDialog As FileDialog
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Choose folder with .par, which should be processed"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
FilePathPAR = xStrPath
End Sub
Display More
Here is code for creating new book with every .par files
Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFile As String
Dim xFiles As New Collection
Dim i As Long
Dim LastRow As Long
Dim wsh As Worksheet
'Disable Error Windows
Application.DisplayAlerts = False
If Right(FilePathPAR, 1) <> "\" Then FilePathPAR = FilePathPAR & "\"
xFile = Dir(FilePathPAR & "*.par")
Do While xFile <> ""
xFiles.Add xFile, xFile
xFile = Dir()
Loop
Set xToBook = Workbooks.Add
If xFiles.Count > 0 Then
For i = 1 To xFiles.Count
Set xWb = Workbooks.Open(FilePathPAR & xFiles.Item(i))
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
On Error GoTo 0
xWb.Close Save = False
Next
'Enable Error Windows
Application.DisplayAlerts = True
End Sub
Display More