I would like to create a regular folder instead of a zip folder. How would I adjust the following code?
' MacroCREATEZIPFOLDER Macro
'
'
'
Application.ScreenUpdating = False
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long, i As Integer
Dim FName, vArr, FileNameZip
Dim Wkbk
Dim x As Integer, y As Integer
DefPath = "Z:\_R.2.BATCH\"
' FileNameZip = DefPath & "MyFilesZip " & ".zip"
'Browse to the file(s), use the Ctrl key to select more files
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True, Title:="Go into DO NOT DELETE THIS FOLDER and Highlight ALL of the Excel spreadsheets")
If IsArray(FName) = False Then
'do nothing
Else
'Create empty Zip File
Set oApp = CreateObject("Shell.Application")
i = 0
For iCtr = LBound(FName) To UBound(FName)
vArr = Split97(FName(iCtr), "\")
sFName = vArr(UBound(vArr))
x = InStr(sFName, ".")
y = Len(sFName)
Wkbk = Left(sFName, y - (y - x) - 1)
FileNameZip = DefPath & Wkbk & ".zip"
NewZip (FileNameZip)
If bIsBookOpen(sFName) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close it and try again: " & FName(iCtr)
Else
'Copy the file to the compressed folder
i = i + 1
oApp.Namespace(FileNameZip).CopyHere FName(iCtr)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).Items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
Next iCtr
End If
End Sub
Sub NewZip(sPath As String)
'
' NewZip Macro
'
'Create empty Zip File
Application.ScreenUpdating = False
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function Split97(sStr As Variant, sdelim As String) As Variant 'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Bookmarks