|
本帖最后由 roych 于 2010-12-22 17:53 编辑
用format来判断格式就好了~~先贴代码上来以便无法下载附件的网友看看:
- Private Sub 导出数据_Click()
- Dim fso As Object
- '创建组件
- Set fso = CreateObject("Scripting.FileSystemObject")
- '判断相对路径下是否存在这个文件
- If fso.FileExists(CurrentProject.Path & "" & Format(Date - 1, "MMDD") & ".xls") = False Then
- MsgBox CurrentProject.Path & "" & Format(Date - 1, "MMDD") & ".xls"
- MsgBox "在指定路径下:" & CurrentProject.Path & "" & Chr(13) & "找不到文件:" & Format(Date - 1, "MMDD") & ".xls"
- Exit Sub
- Else
- '消除生成表的警告
- DoCmd.SetWarnings False
- MsgBox "Dyesect导出的Excl文件必须以日期来命名" & Chr(13) & Chr(13) & "例如,0805.xls,准备好了就按OK吧!", vbOKCancel, "导出数据注意事项"
- '链接数据表,主要因为某些字段含有点号,直接导入会出错。
- DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "tem", CurrentProject.Path & "" & Format(Date - 1, "MMDD") & ".xls", True
- '执行生成表查询
- DoCmd.OpenQuery "Q_WFT"
- '开始到处生成表
- DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "WFT", Me.导出路径.Value, True
- '提示信息
- MsgBox "已成功导出到" & Chr(13) & Chr(13) & Me.导出路径.Value
- '删除临时表,以备下一次执行(如果不删除,下一次链接表就成了Tem1、Tem2……了)
- DoCmd.RunSQL ("Drop table Tem")
- End If
- End Sub
复制代码 需要说明的是,下载后,两个文件必须保存在同一路径下,否则还是无法识别路径的。此外,这里不支持批量导入。不过您也可以根据这些代码写一下。
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|