HELLUP Bestand zippen iva MS Access VBA

[richard99]

HELLUP

Ik ben dringend op zoek naar VBA code om bestanden te zippen. Zag wat over excel en workbook alleen gaat deze niet op aangezien het in excel plaatsvindt. Ik zoek gewoon code om vanuit VBA in Access een bestand te zippen.

 

[OctaFish]

En wat wil je precies zippen?

 

[richard99]

Gewoon een bestand, kan een tekstbestand zijn maar ook een Access database met extentie .mdb.
Maak dat uit?
Ik hoop echt dat je me kan helpen.

 

[OctaFish]

Dat maakt uit als je de geopende database wilt zippen. Want die is op dat moment gelockt, dus dat wil niet altijd lukken. Overigens heeft deze vraag weinig met Access te maken, maar lijkt het een algemene vraag te zijn. De oplossing is vermoed ik dan ook een algemene: met het Shell commando moet het wel lukken. Als je met de wizard een knop maakt die een programma opent, dan zie je de syntax van dat commando. In je zip pakket vind je de juiste parameter om een bestaand document te zippen.

 

[richard99]

Nee dat klopt dat de database niet open mag zijn en deze is op dat moment gesloten. Ik gebruik MS Access 2003, heb jij VBA code voor mij zodat ik het kan testen?

 

[richard99]

Beste redacteur,

Kan je aub de syntaxis leveren want handmatig zippen begrijp ik. Ik wil juist een bestand zippen dat vanuit de syntaxis uitgevoerd wordt. De shell comando heb ik onderzocht maar kan niet vinden over zippen.
Aub wil jij zo vriendelijk even de betreffende syntaxis aan te leveren?
Ik heb een syntaxis hier ergens gevonden echter is dit vanuit Excel aangeroepen en niet vanuit Access.
Als ik dit uitvoert dan maakt hij alleen een zipbestand aan echter zipt hij niet test.xls in de zipfile.

Dim strDate As String, DefPath As String
Dim FileNameZip, FileNameXls
Dim oApp As Object

'If ActiveWorkbook Is Nothing Then Exit Sub
'DefPath = ActiveWorkbook.Path
DefPath = "C:\"
strEffe = "C:\test.xls"
If Len(DefPath) = 0 Then
MsgBox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping"
Exit Sub
End If

'Create date/time string and the temporary xls and zip file name
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "test" & strDate & ".zip"
FileNameXls = DefPath & "test" & strDate & ".xls"

If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then

'Make copy of the activeworkbook
'ActiveWorkbook.SaveCopyAs FileNameXls

'Create empty Zip File
newzip (FileNameZip)
strEffe = "C:\test.xls"
'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere strEffe

'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 "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping"

Else
MsgBox "FileNameZip or/and FileNameXls exist", vbInformation, "zipping"

End If

 

[OctaFish]

Als je je voorbeeld goed leest, zie je dat je ook een Shell commando gebruikt. Zoals ik al zei: wat je wilt doen heeft op zich niks met Access te maken, maar is het uitvoeren van een opdrachten die je vanuit elk pakket dat VBA ondersteunt kunt laten draaien. Dus de code is voor Excel en Access nagenoeg gelijk. Het verschil zou hooguit kunnen zijn dat je een tabel of werkblad wilt opslaan, en zippen. Het opslaan is dan programma-specifiek; het zippen niet.

Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere strEffe

Dus ik zou niks anders doen dan deze code voor je overschrijven.... Lijkt mij niet echt zinvol. Ik zou zo ook niet kunnen zeggen waarom je code niet werkt, want ik zit nu even tijdelijk zonder Office, dus ik kan 'm niet testen.
Verzoekje: kun je code opmaken met de CODE tag (knop #) dat maakt de code een stuk leesbaarder.