Crear carpeta con el nombre del fichero .zip

Prueba la siguiente:

Sub CrearCarpeta()
  Dim sourceFolder As String, destfolder As String
  Dim file As String
  Dim p As Long
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Selecciona la carpeta que contiene los archivos. zip"
    .InitialFileName = ThisWorkbook.Path
    If Not .Show Then Exit Sub
    sourceFolder = .SelectedItems(1) & "\"
  End With
  file = Dir(sourceFolder & "*.zip")
  While file <> vbNullString
    p = InStrRev(file, ".") - 1
    destfolder = Left(file, p)
    MkDir sourceFolder & destfolder
    file = Dir
  Wend
End Sub

Hola Dante!

Muy buen día, Ud es un genio! Funciono perfecto, muchas gracias, pudiera agregarle a la macro el mover los ficheros .zip para dentro de cada carpeta creada, ¿y descompactarlo?

Hola Muy buenas tardes,

Le agregue a la macro esta instrucción debajo del MkDir para que me mueva el .zip a la carpeta creada.

Name file As sourceFolder & destfolder & "\" & file

Pero me da el error de "File not Found".

¿Alguna idea?

Un saludo,

Aleida

Hola Dante!

Ya resolví el problema del error con la instrucción de esta manera:

Name sourceFolder & "\" & file As sourceFolder & destfolder & "\" & file

Solo me queda poder descompactar el fichero zip en cada folder.

¿Otra idea para esto?

Gracias y que tengas una linda tarde,

Aleida