Problem with multiple XLS files ..........


Posted by Nicolas Sirot on July 06, 2000 8:46 AM

Hi,
I hope that you could really help, as this is really a problem for me.
Every day, i've got an application that generate many CSV files, that i convert with a macro (i've done that).
Normally, this work is done during the night, so the morning, i find my "just new converted" XLS files, that i can send to another people.
But now, they would like me to generate 1 single XLS file, with as many worksheet than there are CSV files become the import.
Do you have any clue to give me on how to automate this task ??
Thank you in advance
Nicolas

Posted by Nicolas Sirot on July 07, 0100 12:53 AM

Ryan,
Here is my original code for the first part of the macro :

Option Explicit

Public Type BROWSEINFO
hOwner As Long
pid1Root As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32bit API declarations
Declare Function SHGetPathFromIdList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pid1 As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
'
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Root folder = desktop
bInfo.pid1Root = 0&

'Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder"
Else
bInfo.lpszTitle = Msg
End If

'Type of Dir to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
r = SHGetPathFromIdList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function


Sub Conversion_CSV_en_XLS()
'
Dim i As Integer
Dim Drive As String
Dim Ans As Integer
Dim Filename 'Must be a variant !!
Dim ChFiles() As String
Dim FFiles As Integer
Dim WB As Integer
Dim test As String
Dim Q As Integer
Dim OldSB As Boolean
Dim NewSB

SelectAgain:
'---------------------
Drive = GetDirectory("Choix du répertoire des fichiers CSV :")
If Drive = "" Then End
Ans = MsgBox(Drive, vbInformation + vbYesNo, "Convertir tous les fichiers CSV?")
If Ans = vbNo Then GoTo SelectAgain
'----------------------

With Application.FileSearch
.NewSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = "*.CSV"
.MatchTextExactly = True
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
ReDim ChFiles(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
ChFiles(i) = .FoundFiles(i)
Next
End If
If .FoundFiles.Count = 0 Then
Q = MsgBox("Aucun fichiers CSV dans " & Drive & Chr(13) & Chr(13) & _
"Choisir un autre répertoire?", vbExclamation + vbYesNo, "Search Result")
If Q = vbYes Then GoTo SelectAgain
End
End If
End With
'---------------------------------------------------------------------
On Error GoTo ErrH

'Turn off Screenupdatin to speed things up
Application.ScreenUpdating = False

'Setup Statusbar to inform user
OldSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True

'Now process array
For WB = 1 To UBound(ChFiles())

Workbooks.Open ChFiles(WB)
Application.StatusBar = "Formating:=" & ChFiles(WB) & ":Count=" & WB
'Now format sheet as per your QUESTION
With ActiveSheet.Cells
.Columns.AutoFit
End With
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & _
"xls", FileFormat:=xlNormal
ActiveWorkbook.Close

Next
Application.ScreenUpdating = True

MsgBox "Conversion effectué des fichiers CSV dans : " & Drive & _
Chr(13) & Chr(13) & WB - 1 & " Fichiers formatés & Sauvegardés au format .xls", vbInformation
Application.DisplayStatusBar = OldSB
Application.StatusBar = False

Exit Sub

ErrH:
MsgBox Err.Number & " :=" & Err.Description

End Sub

Hope that it will help you.
--------------------------------------------------

Posted by Ivan Moala on July 07, 0100 3:04 AM

Hi Nicolas
This one looks familiar :-)

Try this amendment....if it doesn't work let me know

Ivan

Dim i As Integer
Dim Drive As String
Dim Ans As Integer
Dim Filename 'Must be a variant !!
Dim ChFiles() As String
Dim FFiles As Integer
Dim WB As Integer
Dim test As String
Dim Q As Integer
Dim OldSB As Boolean
Dim NewSB
Dim NewWBk_Name
'Dim NewWBk As Workbook

SelectAgain:
'---------------------
Drive = GetDirectory("Select the directory of the files to change the format for:")
If Drive = "" Then End
Ans = MsgBox(Drive, vbInformation + vbYesNo, "Load all CSV files in this Directory?")
If Ans = vbNo Then GoTo SelectAgain
'----------------------

With Application.FileSearch
.NewSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = "*.CSV"
.MatchTextExactly = True
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
ReDim ChFiles(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
ChFiles(i) = .FoundFiles(i)
Next
End If
If .FoundFiles.Count = 0 Then
Q = MsgBox("No CSV files in " & Drive & Chr(13) & Chr(13) & _
"Select another Dir?", vbExclamation + vbYesNo, "Search Result")
If Q = vbYes Then GoTo SelectAgain
End
End If
End With
'---------------------------------------------------------------------
On Error GoTo ErrH

'Now create a New workbook to update the CSV files In
NewWBk_Name = Application.InputBox("Enter new workbook Name", "Workbook Name", Type:=2)
If NewWBk_Name = False Then End
Workbooks.Add (xlWBATWorksheet)
ActiveWorkbook.SaveAs Filename:=NewWBk_Name

'Turn off Screenupdating to speed things up
Application.ScreenUpdating = False

'Setup Statusbar to inform user
OldSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True


'Now process array
For WB = 1 To UBound(ChFiles())

Workbooks.Open ChFiles(WB)
Application.StatusBar = "Formating:=" & ChFiles(WB) & ":Count=" & WB
'Now format sheet as per your QUESTION
With ActiveSheet.Cells
.Columns.AutoFit
End With
ActiveSheet.Move Before:=Workbooks(NewWBk_Name & ".xls").Sheets(1)
Next
ActiveWorkbook.Save
Application.ScreenUpdating = True

MsgBox "Completed updating CSV files to: " & NewWBk_Name & _
Chr(13) & Chr(13) & WB - 1 & " Files formated/Saved into WorkBook " & NewWBk_Name, vbInformation

Application.DisplayStatusBar = OldSB
Application.StatusBar = False

Exit Sub

ErrH:
MsgBox Err.Number & " :=" & Err.Description

End Sub

Posted by Nicolas Sirot on July 07, 0100 6:56 AM

Again !!!
Your still here when i need your help
Thanks again, as you may know, it work very fine except that it import the CSV file as each CSV are import in 1 single sheet, but then, there is no conversion in XLS : so the whole content of the CSV is include in the A column ;-(
Any idea why there is no formating of the file ??
See soon and thanks for your very GREAT effort,
Nicolas

Posted by Ryan on July 06, 0100 1:13 PM

Nicolas,

If you post your original, I can take a look at it to see what can be done.

Ryan

Posted by Ivan Moala on July 07, 0100 2:04 PM


Hi Nicolas
It worked for me, the formatting that is ??
perhaps you can send me your file....I may have
missed something ???

Ivan



Posted by Ryan on July 06, 0100 8:36 PM

Nicolas,

If you post your original code, I can take a look at it to see what can be done.

Ryan