+ Reply to Thread
Results 1 to 7 of 7

Adjusting the follow code to create a folder instead of a zip folder

  1. #1
    Registered User
    Join Date
    11-01-2012
    Location
    usa
    MS-Off Ver
    Excel 2007
    Posts
    10

    Adjusting the follow code to create a folder instead of a zip folder

    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

  2. #2
    Forum Expert
    Join Date
    07-15-2012
    Location
    Leghorn, Italy
    MS-Off Ver
    Excel 2010
    Posts
    3,431

    Re: Adjusting the follow code to create a folder instead of a zip folder

    why adjust a zip code ?
    Please Login or Register  to view this content.
    If solved remember to mark Thread as solved

  3. #3
    Registered User
    Join Date
    11-01-2012
    Location
    usa
    MS-Off Ver
    Excel 2007
    Posts
    10

    Re: Adjusting the follow code to create a folder instead of a zip folder

    I need the ability to make changes to the files within the zip folder and would prefer a regular folder instead.

  4. #4
    Forum Expert
    Join Date
    07-15-2012
    Location
    Leghorn, Italy
    MS-Off Ver
    Excel 2010
    Posts
    3,431

    Re: Adjusting the follow code to create a folder instead of a zip folder

    I don't need to adjust your code, you can create a regular folder with
    Please Login or Register  to view this content.

  5. #5
    Registered User
    Join Date
    11-01-2012
    Location
    usa
    MS-Off Ver
    Excel 2007
    Posts
    10

    Re: Adjusting the follow code to create a folder instead of a zip folder

    Patel45.... I need to create a folder for each .xls selected, how do I do that?

  6. #6
    Forum Expert
    Join Date
    07-15-2012
    Location
    Leghorn, Italy
    MS-Off Ver
    Excel 2010
    Posts
    3,431

    Re: Adjusting the follow code to create a folder instead of a zip folder

    Please Login or Register  to view this content.

  7. #7
    Registered User
    Join Date
    11-01-2012
    Location
    usa
    MS-Off Ver
    Excel 2007
    Posts
    10

    Re: Adjusting the follow code to create a folder instead of a zip folder

    Awesome! Thank you so much!

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1