Hi, hope someone can help!
The below code unzips a non-password protected file perfectly.
However not for a password protected file.
I have struggled to find a solution using the famous search engine.
Can anyone help, or at least aid with an alternative vba?
Thanks
Function Unzip1(ZippedFile As String)
Dim fso As Object
Dim oApp As Object
Dim fname
Dim DefPath As String
Dim strDate As String
Dim strRootPDFPath As String
strRootPDFPath = "C:\Users\" + Environ("Username") + "\Downloads\"
''fname = strRootPDFPath & ZippedFile 'fname = CurrentProject.Path & "\Tek-Tips.zip"
fname = strRootPDFPath & "Ethics_Booklet.zip" 'fname = CurrentProject.Path & "\Tek-Tips.zip"
If fname = False Then
'do nothing
Else
'Set default path to current database folder
DefPath = CurrentProject.Path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'strDate = Format(Now, " dd-mm-yy h-mm-ss")
''Create normal folder
Dim FileNameFolder As String
FileNameFolder = strRootPDFPath & "PDFs"
If FolderExistsCreate(strRootPDFPath & "PDFs", True) Then
Else
MkDir strRootPDFPath & "PDFs"
End If
Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.NameSpace(strRootPDFPath & "PDFs").CopyHere oApp.NameSpace(fname).Items, 4 + 16 '4 + 16 To override and suppress dialog
'MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set fso = CreateObject("scripting.filesystemobject")
fso.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set fso = Nothing
End If
End Function
The below code unzips a non-password protected file perfectly.
However not for a password protected file.
I have struggled to find a solution using the famous search engine.
Can anyone help, or at least aid with an alternative vba?
Thanks
Function Unzip1(ZippedFile As String)
Dim fso As Object
Dim oApp As Object
Dim fname
Dim DefPath As String
Dim strDate As String
Dim strRootPDFPath As String
strRootPDFPath = "C:\Users\" + Environ("Username") + "\Downloads\"
''fname = strRootPDFPath & ZippedFile 'fname = CurrentProject.Path & "\Tek-Tips.zip"
fname = strRootPDFPath & "Ethics_Booklet.zip" 'fname = CurrentProject.Path & "\Tek-Tips.zip"
If fname = False Then
'do nothing
Else
'Set default path to current database folder
DefPath = CurrentProject.Path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'strDate = Format(Now, " dd-mm-yy h-mm-ss")
''Create normal folder
Dim FileNameFolder As String
FileNameFolder = strRootPDFPath & "PDFs"
If FolderExistsCreate(strRootPDFPath & "PDFs", True) Then
Else
MkDir strRootPDFPath & "PDFs"
End If
Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.NameSpace(strRootPDFPath & "PDFs").CopyHere oApp.NameSpace(fname).Items, 4 + 16 '4 + 16 To override and suppress dialog
'MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set fso = CreateObject("scripting.filesystemobject")
fso.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set fso = Nothing
End If
End Function