I've found and have used some VBA coding to zip an Excel file. It works well.
I now want to copy that zipped file to a sharepoint.
I have coding to save a current workbook to a sharepoint, folder, etc. I do NOT have coding to call up the file I just zipped and move that newly zipped file to a sharepoint.
Can anyone please advise as to how I could call up the file I have just zipped and move that newly zipped file to Sharepoint?
Below is the coding for zipping the file using VBA.
Thank you!
Brandon
Sub Zip_ActiveWorkbook()
Dim strDate As String, DefPath As String
Dim FileNameZip, FileNameXls
Dim oApp As Object
Dim FileExtStr As String
DefPath = "C:\Documents and Settings\YOURFOLDER" '<< Change
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create date string and the temporary xl* and Zip file name
If Val(Application.Version) < 12 Then
FileExtStr = ".xls"
Else
Select Case ActiveWorkbook.FileFormat
Case 51: FileExtStr = ".xlsx"
Case 52: FileExtStr = ".xlsm"
Case 56: FileExtStr = ".xls"
Case 50: FileExtStr = ".xlsb"
Case Else: FileExtStr = "notknown"
End Select
If FileExtStr = "notknown" Then
MsgBox "Sorry unknown file format"
Exit Sub
End If
End If
strDate = Format(Now, " mm-dd-yyyy")
FileNameZip = DefPath & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - Len(FileExtStr)) & strDate & ".zip"
FileNameXls = DefPath & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - Len(FileExtStr)) & strDate & FileExtStr
If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
'Make copy of the activeworkbook
ActiveWorkbook.SaveCopyAs FileNameXls
'Create empty Zip File
NewZip (FileNameZip)
'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FileNameXls
'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
'Delete the temporary xls file
Kill FileNameXls
'-------------------------------------------------------------
MsgBox "Your Backup is saved here: " & FileNameZip
Else
MsgBox "FileNameZip or/and FileNameXls exist"
End If
End Sub