creating an excel from CSV folder

haleem100

Board Regular
Joined
Jul 29, 2014
Messages
53
Hi
I am trying to create an excel file from a bunch of CSV files that are saved, in an zip folder.
So I have a Zip folder that has 7 CSV files, I am trying to create an excel spreadhseet for them to be input in to different tabs. I managed to do that but it is getting saved in of of my folders, I need it to just to have the excel, but not get it saved, but just open the file in a new window.
This is the code I have
Option Explicit


Sub UnzipAndMerge()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String, StrFile As String
Dim I As Long, Wb As Workbook, FinalWb As Workbook
Dim num As Long, Sht As Worksheet, ShtName As String

ChDir (ThisWorkbook.Path)
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=True)
If IsArray(Fname) Then
'Root folder for the new folder.
DefPath = ThisWorkbook.Path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If


'Create the folder name
strDate = format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"


'Make the normal folder in DefPath
MkDir FileNameFolder


'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")


For I = LBound(Fname) To UBound(Fname)
num = oApp.Namespace(FileNameFolder).items.Count
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items

Set FinalWb = Workbooks.Add
StrFile = Dir(FileNameFolder)
Do While Len(StrFile) > 0
Set Wb = Workbooks.Open(FileNameFolder & StrFile)
Wb.Sheets(1).Copy FinalWb.Sheets(1)
Wb.Close False
Set Wb = Nothing
StrFile = Dir
Loop

'On Error Resume Next
DeleteFolder (FileNameFolder)
For Each Sht In FinalWb.Sheets
Select Case Right(Sht.Name, 3)
Case "MON"
Sht.Name = "MONDAY"
Sht.Move FinalWb.Sheets(2)
Case "TUE"
Sht.Name = "TUESDAY"
Sht.Move FinalWb.Sheets(3)
Case "WED"
Sht.Name = "WEDNESDAY"
Sht.Move FinalWb.Sheets(4)
Case "THU"
Sht.Name = "THURSDAY"
Sht.Move FinalWb.Sheets(5)
Case "FRI"
Sht.Name = "FRIDAY"
Sht.Move FinalWb.Sheets(6)
Case "SAT"
Sht.Name = "SATURDAY"
Sht.Move FinalWb.Sheets(7)
Case "SUN"
Sht.Name = "SUNDAY"
Sht.Move FinalWb.Sheets(1)
Case "et1", "et2", "et3"
Sht.Delete
End Select
Next Sht
FinalWb.SaveAs ThisWorkbook.Path & "\Next weeks logs" & 1
On Error GoTo 0
FinalWb.Close
Set FinalWb = Nothing
Next I


MsgBox "You find the files here: " & FileNameFolder


On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
On Error GoTo 0
End If
End Sub


Sub DeleteFolder(MyPath As String)
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
FSO.DeleteFolder MyPath
End Sub

Please advice
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I'd think you just remove this:
Code:
 FinalWb.SaveAs ThisWorkbook.Path & "\Next weeks logs" & 1
 On Error GoTo 0
 FinalWb.Close
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,162
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top