如何在Access2007数据库的函数中使用VBA压缩.xlsx电子表格 [英] How zip a .xlsx spreadsheet with VBA from within a function of an Access2007 database
问题描述
我需要制作一份我在Access2007中以xlsx格式创建的电子表格的压缩副本。 这需要遵循电子表格的创建，因为路径和文件名也是以编程方式创建的。
我目前的代码是：
   DoCmd.TransferSpreadsheet acExport，acSpreadsheetTypeExcel12，rptName，rptMyPath& " tempTemplateX" &安培; " .xlsx"，True，" PutItHere"
'PutItHere是模板上的范围
FileCopy rptMyPath& " tempTemplateX" &安培; ".xlsx"，rptMyPath& rptNameNew& " .xlsx"
FileCopy rptMyPath& " tempTemplateX" &安培; " .xlsx"，rptMyPathTemp& rptNameNew& " .xlsx"
Hi JR，
在Access中没有内置的方法来执行此操作，但您可以尝试使用类似于我在下面发布的代码。
此代码使用默认的Windows zip程序。
除了以下代码之外，我还可以进行快速的Bing搜索并找到一些3< sup> rd< / sup>使用类似于以下代码的派对网站，并提供了压缩代码的其他示例。
Ex。 http：//www.rondebruin。 nl / windowsxpzip.htm
希望这会有所帮助。
Private Sub Command0_Click（）
Dim strDate As String，DefPath As String
Dim oApp As Object
Dim FName，FileNameZip
'设置保存文件的默认路径。
DefPath = CurrentProject.Path
如果正确（DefPath，1）<> " \"然后
DefPath = DefPath& " \"
结束如果
strDate =格式（现在，"dd-mmm-yy h-mm-ss"）
FileNameZip = DefPath& "MyFilesZip" &安培; strDate& " .zip"
'要压缩的文件
FName =" C：\\\test.xlsx"
'创建空Zip文件
NewZip（FileNameZip）
设置oApp = CreateObject（" Shell.Application"）
oApp.NameSpace（FileNameZip）.CopyHere FName
MsgBox"你在这里找到zipfile：" &安培; FileNameZip
设置oApp = Nothing
End Sub
Sub NewZip（sPath）
'创建空Zip文件
Dim oFSO，arrHex，sBin，i，Zip
设置oFSO = CreateObject（" Scripting.FileSystemObject"）
arrHex =数组（80,75,5,6,0,0,0，_
0,0,0,0,0,0,0,0,0， 0,0,0,0,0）
对于i = 0到UBound（arrHex）
sBin = sBin& Chr（arrHex（i））
下一页
< span style ="font-family：Calibri">
使用oFSO.CreateTextFile（sPath，True）
。写sBin
。关闭
结束
End Sub
最好的问候，
Nathan Ost
Microsoft在线社区支持
I need to make a zipped copy of a spreadsheet I create in xlsx format in Access2007. This needs to follow the creation of the spreadsheet as the path and file name are also created programmatically.
My code at present is:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, rptName, rptMyPath & "tempTemplateX" & ".xlsx", True, "PutItHere"
' PutItHere is the range on the template
FileCopy rptMyPath & "tempTemplateX" & ".xlsx", rptMyPath & rptNameNew & ".xlsx"
FileCopy rptMyPath & "tempTemplateX" & ".xlsx", rptMyPathTemp & rptNameNew & ".xlsx"解决方案Hi JR,
There is not a built in way from within Access to do this, but you could try using code similar to what I posted below. This code uses the default windows zip program. In addition to the code below, I was able to do a quick Bing search and find a few 3<sup>rd</sup> party sites that used code similar to the following and provided other examples of zipping code. Ex. http://www.rondebruin.nl/windowsxpzip.htm
Hope this helps.
Private Sub Command0_Click()
Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
'sets the default path to save the files to.
DefPath = CurrentProject.Path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
'File you want to zip
FName = "C:\Data\test.xlsx"
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(FileNameZip).CopyHere FName
MsgBox "You find the zipfile here: " & FileNameZip
Set oApp = Nothing
End Sub
Sub NewZip(sPath)
'Create empty Zip File
Dim oFSO, arrHex, sBin, i, Zip
Set oFSO = CreateObject("Scripting.FileSystemObject")
arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(arrHex)
sBin = sBin & Chr(arrHex(i))
Next
With oFSO.CreateTextFile(sPath, True)
.Write sBin
.Close
End With
End Sub
Best Regards,
Nathan Ost
Microsoft Online Community Support
这篇关于如何在Access2007数据库的函数中使用VBA压缩.xlsx电子表格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
