daisyplastow
New Member
- Joined
- May 19, 2017
- Messages
- 1
Hi,
I'm new to the forums and need some helping in adapting some code please. The code below currently works great, it cycles through folders in a set location to open and copy worksheet "ExportCSV" from many workbooks, in these folders.
What I need it to do instead is rather than creating a new csv file for each workbook, is to create a new sheet in the master workbook ie the workbook the code is running in. I want to keep the process it currently does, in documenting the folder/name/location etc in the sheet "overview".
Ideally the worksheets should be named the same as the source workbooks...
Can anyone please help?
Current Code:
Sub GetSheets()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Cells(2, 2) = Now
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFolder1 As Object
Dim cfName As String
Dim i As Integer
Dim MasterCSV As Workbook
Dim SourceCSV As Workbook
Dim wbName As String
Dim fName As String
Dim ffName As String
Dim cName As String
Dim rE As Integer
Dim MinDate As Date
Dim MaxDate As Date
Dim Vol As Single
Set MasterCSV = Application.ThisWorkbook
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area")
i = 15
For Each objSubFolder In objFolder.subfolders
Dim aFile As String
aFile = objFolder.Path & "" & objSubFolder.Name & "\thumbs.db"
On Error Resume Next
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
cfName = objFolder.Path & "" & objSubFolder.Name 'current folder name
Set objFolder1 = objFSO.GetFolder(cfName)
Sheets("Overview").Cells(i + 1, 1) = objSubFolder.Name
Sheets("Overview").Cells(i + 1, 8) = Now
For Each objFile In objFolder1.Files
ffName = objFile.Path
fName = objFile.Name
cName = Left(fName, Len(fName) - 4)
Application.StatusBar = "Creating " & cName & " CSV"
Sheets("Overview").Cells(i + 1, 2) = objFile.Name
Sheets("Overview").Cells(i + 1, 3) = objFile.Path
Set SourceCSV = Application.Workbooks.Open(ffName)
Sheets("ExportCSV").Visible = True
Sheets("ExportCSV").Select
rE = Application.CountA(Range(Cells(1, 1), Cells(65536, 1)))
MinDate = Application.Min(Range(Cells(1, 2), Cells(rE, 2)))
MaxDate = Application.Max(Range(Cells(1, 2), Cells(rE, 2)))
Vol = Application.Sum(Range(Cells(1, 5), Cells(rE, 5)))
ActiveSheet.Unprotect "secret"
If rE = 0 Then
Else
ActiveSheet.Unprotect "secret"
Range(Cells(1, 2), Cells(rE, 2)).NumberFormat = "d/mmm/yy"
Sheets("ExportCSV").Copy
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim tCSV As String
If Left(cName, 4) = "Game" Then
TempFilePath = "\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area"
Else
TempFilePath = "\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area"
End If
TempFileName = cName
FileExtStr = ".csv"
tCSV = TempFileName & FileExtStr
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=xlCSVMSDOS, CreateBackup:=False
ActiveSheet.Unprotect "secret"
BulkBagUpdate tCSV, rE, TempFileName
ActiveWorkbook.Close TempFilePath & TempFileName & FileExtStr
Application.DisplayAlerts = True
End If
CloseWithoutSave fName
Sheets("Overview").Select
Cells(i + 1, 4) = MinDate
Cells(i + 1, 5) = MaxDate
Cells(i + 1, 6) = Vol
Cells(i + 1, 7) = rE
Cells(i + 1, 9) = Now
Cells(i + 1, 10) = Cells(i + 1, 9) - Cells(i + 1, 8)
i = i + 1
Cells(i + 1, 8) = Now
Next objFile
Next objSubFolder
Cells(2, 3) = Now
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
I'm new to the forums and need some helping in adapting some code please. The code below currently works great, it cycles through folders in a set location to open and copy worksheet "ExportCSV" from many workbooks, in these folders.
What I need it to do instead is rather than creating a new csv file for each workbook, is to create a new sheet in the master workbook ie the workbook the code is running in. I want to keep the process it currently does, in documenting the folder/name/location etc in the sheet "overview".
Ideally the worksheets should be named the same as the source workbooks...
Can anyone please help?
Current Code:
Sub GetSheets()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Cells(2, 2) = Now
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFolder1 As Object
Dim cfName As String
Dim i As Integer
Dim MasterCSV As Workbook
Dim SourceCSV As Workbook
Dim wbName As String
Dim fName As String
Dim ffName As String
Dim cName As String
Dim rE As Integer
Dim MinDate As Date
Dim MaxDate As Date
Dim Vol As Single
Set MasterCSV = Application.ThisWorkbook
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area")
i = 15
For Each objSubFolder In objFolder.subfolders
Dim aFile As String
aFile = objFolder.Path & "" & objSubFolder.Name & "\thumbs.db"
On Error Resume Next
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
cfName = objFolder.Path & "" & objSubFolder.Name 'current folder name
Set objFolder1 = objFSO.GetFolder(cfName)
Sheets("Overview").Cells(i + 1, 1) = objSubFolder.Name
Sheets("Overview").Cells(i + 1, 8) = Now
For Each objFile In objFolder1.Files
ffName = objFile.Path
fName = objFile.Name
cName = Left(fName, Len(fName) - 4)
Application.StatusBar = "Creating " & cName & " CSV"
Sheets("Overview").Cells(i + 1, 2) = objFile.Name
Sheets("Overview").Cells(i + 1, 3) = objFile.Path
Set SourceCSV = Application.Workbooks.Open(ffName)
Sheets("ExportCSV").Visible = True
Sheets("ExportCSV").Select
rE = Application.CountA(Range(Cells(1, 1), Cells(65536, 1)))
MinDate = Application.Min(Range(Cells(1, 2), Cells(rE, 2)))
MaxDate = Application.Max(Range(Cells(1, 2), Cells(rE, 2)))
Vol = Application.Sum(Range(Cells(1, 5), Cells(rE, 5)))
ActiveSheet.Unprotect "secret"
If rE = 0 Then
Else
ActiveSheet.Unprotect "secret"
Range(Cells(1, 2), Cells(rE, 2)).NumberFormat = "d/mmm/yy"
Sheets("ExportCSV").Copy
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim tCSV As String
If Left(cName, 4) = "Game" Then
TempFilePath = "\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area"
Else
TempFilePath = "\\pggbssc1fil011.bsg.local\Man_DocHandling\Forecasting\Daisy Development 2017\Test Area"
End If
TempFileName = cName
FileExtStr = ".csv"
tCSV = TempFileName & FileExtStr
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=xlCSVMSDOS, CreateBackup:=False
ActiveSheet.Unprotect "secret"
BulkBagUpdate tCSV, rE, TempFileName
ActiveWorkbook.Close TempFilePath & TempFileName & FileExtStr
Application.DisplayAlerts = True
End If
CloseWithoutSave fName
Sheets("Overview").Select
Cells(i + 1, 4) = MinDate
Cells(i + 1, 5) = MaxDate
Cells(i + 1, 6) = Vol
Cells(i + 1, 7) = rE
Cells(i + 1, 9) = Now
Cells(i + 1, 10) = Cells(i + 1, 9) - Cells(i + 1, 8)
i = i + 1
Cells(i + 1, 8) = Now
Next objFile
Next objSubFolder
Cells(2, 3) = Now
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub