PDA

View Full Version : Open multiple files as workbooks



LinkND
05-28-2008, 12:59 AM
If I want to open - let's say - five different text files (this can be more than five though) by using the method to select multiple files, how do you open them all as different workbooks and let the system ask you to save the workbook as the name of the file. Below I have a function to make new workbooks with one sheet.

Private Sub NewWB()
Set wb = NewWorkbook(1)
End Sub

Function NewWorkbook(wsCount As Integer) As Workbook
Dim OriginalWorksheetCount As Long
Set NewWorkbook = Nothing
If wsCount < 1 Or wsCount > 255 Then Exit Function
OriginalWorksheetCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = wsCount
Set NewWorkbook = Workbooks.Add
Application.SheetsInNewWorkbook = OriginalWorksheetCount
End Function

Within each workbook there is a macro running before he wants to save it, but that macro is already working. I'll add stuff later on, but I want to try saving them first because I am constantly testing in the same workbook.

So it goes like this:

select files -> open new workbook -> run macro I already have -> save workbook as name of the opened file -> go to next new workbook with the second file from the list -> repeat the same process until all files are saved as their own name (workbook).

I was thinking of a 'for each' loop to read the files and let the workbook be added by the system in steps.

Bob Phillips
05-28-2008, 02:21 AM
Why don't you cut some code and then show as that. I got confused by the talk of text files, workbooks wit code, files from a list and so on.

LinkND
05-28-2008, 02:50 AM
Hmm, the below code is a part of my main code. Let's take this code as the only thing it will do for me. (don't mind the comments, they are in Dutch hehe...)

The code will be triggered when a file is imported (OpenDialog). However, I am only importing one file at a time right now. So the code will do his work on this file and the sheet is done. Just a few seconds of processing.

I want to select more textfiles this time. Selecting them isn't difficult, because this is already a part of Excel. But if I'm selecting file A, file B and file C in my directory, I want the code to open a new workbook for me for each file, triggers the code below on file A and asks me to save the workbook (as the name of the file). So file A will be saved as file A.xls

Right after that, the code will go to file B, it will do the same thing (triggering, asking to save, done)... until the last selected file is processed.

The code is fixed, which means: the array is focused on a file I only have in my possession. He's cutting the textfile in pieces and put them in cells, but that's nothing to worry about. And I've added some enters at the end of the code because the forum can't handle long rows.

Sub Afbreken()
'Versnel de tijd van de code door updating te deactiveren; activeer hem weer aan het eind.
Application.ScreenUpdating = False

'Het PROD-bestand bevat 41 verschillende velden; definieer deze qua lengte in een vooraf
'ingestele array om de juiste lengte van het tekstbestand af te snijden per karakter.
Dim CharacterLength As Variant
CharacterLength = Array(4, 2, 2, 11, 15, 15, 4, 35, 10, 1, 10, 5, 30, 50, 10, 30, 57, 15, 30, _
10, 60, 10, 40, 4, 35, 4, 70, 3, 30, 11, 11, 16, 16, 11, 16, 11, 11, 11, 11, 7, 8)
'Nu kan het hele Excel-bestand doorlopen worden totdat de eerste lege cel in de A-kolom wordt gevonden.
SheetRow = 1
Do While Cells(SheetRow, 1) <> ""
'Haal de gehele record op en kijk na of de lengte van het bestand klopt met de lengte
'van de vooraf ingestelde lengte van de weg te schrijven tekst in velden en kolommen.
ColumnRecord = Cells(SheetRow, 1)

If Len(ColumnRecord) <> 742 Then
MsgBox ("De lengte van het bestand klopt niet. Pas de lengte aan van de waarden om verder te kunnen gaan.")
Exit Sub
End If

For x = 0 To 40
'Splits het veld af aan de linkerkant van de tekst.
ColumnSplit = Left(ColumnRecord, CharacterLength(x))

'Haal de afgesplitste veld uit de record.
ColumnRecord = Right(ColumnRecord, Len(ColumnRecord) - CharacterLength(x))

'Plaats het afgesplitste veld in de juiste kolom.
Cells(SheetRow, x + 1) = "" & ColumnSplit
Next x

'Ga naar de volgende record in de reeks.
'Doe dit voor het hele bestand in een loop.
SheetRow = SheetRow + 1
Loop
'Activeer updating weer.
Application.ScreenUpdating = True

'Kolommen omlaag gooien en hernoemen met de bijbehorende titels in de bovenste rij.
With ActiveSheet
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
.Range("A1:AO1").Value = Split("JAAR,MAAND_VAN,MAAND_TOT,ACQUIRER_ID,MERCHANT_ID,
CONTRACT_ID,PRODUCT_ID,DATACOM_ID,AUTOMAAT_ID,SF_IN,CREDIT_NR,CREDIT_IBN,
CREDIT_BANK,BEDRIJFSNAAM,LOKATIE_ID,LOKATIE_NM,LOKATIE_ADRES,LOKATIE_
POSTCODE,LOKATIE_PLAATS,BRANCHE_ID,BRANCHE_NM,HOOFDBRANCHE_ID,HOOFDBRANCHE_ NM,
LEVERANCIER_ID,LEVERANCIER_DN,CERTIFICAAT_ID,CERTIFICAAT_DN,STATUS_ID,STATU S_DN,
AANTALTRX_ONUS,AANTALTRX_NOT_ONUS,OMZET_ONUS,OMZET_NOT_ONUS,AANTALTRX,OMZET ,
AANTAL_COLL_DAG,AANTAL_COLL_NACHT,AANTAL_COLL_DAG_NUL,AANTAL_COLL_NACHT_NUL ,
CLUSTER_ID,DATUM", ",")
'Pas de breedte van velden/kolommen automatisch aan.
Cells.EntireColumn.AutoFit

End With

End Sub