|
|
|
学习VBA,由宏开始
——ACCESS篇
说起宏和VBA，不能不提到EXCEL。在EXCEL中，录制宏就是编写VBA代码，可以省下不少时间和学到不少东西.因此在99年，我就通过这种方法及在EXCEL HOME的启发下为单位编写了几个程序，即得到了领导的肯定又确实为经办人员减轻了工作负担，自己得意了好一阵。但是EXCEL在导入、导出外部数据方面远不如ACCESS灵活和简单（其实是自己VBA功力不深），于是根据实际工作的需求，经过一段时间的摸索，基本解决了需求，现记流水帐如下，希望对开始学习VBA FOR ACCESS的兄弟有帮助。
工作目的：从ZIP文件中解压指定的 TXT文件，并将TXT文件中符合条件的记录筛选出来，并另存为一个TXT文件。
解决方法：
1 使用VBA解压指定文件；
主要思路如以下链接：http://mdw.vicp.net/show.asp?id=219
补充以上文章，如果压缩文件中包含目录并要指定文件释放我是按如下格式编写：
Rarexe = "C:\program files\winrar\winrar"
FileString = Rarexe & " x " & " -o+ " & Source & " " & "?11013.txt" & " " & "c:\aas\"
Result = Shell(FileString, vbHide)
Rarexe是WINRAR的路径；
" x " & " -o+ "是WINRAR命令意为解压并覆盖文件；
"?11013.txt"是指定的文件，使用通配符是因为使用完整文件名总是提示找不到文件，加入了路径也是如此。使用通配符后，问题解决。
2 按照指定格式将TXT文件导入ACCESS表中；
首先建立导入（导出）TXT文件的规则；文件——获取外部数据（另存为、导出）——链接表——选择需要链接的文件——链接——高级（设置规则）——保存即可。
然后建立新宏，操作中选择TransferText并在参数设置中填写参数，执行有效后保存。接着通过工具——宏——将宏转换为VBA代码。根据实际需求将代码编写如下：
DoCmd.TransferText acImportFixed, "A11013 链接规格", _
yyyy & mm & q, "c:\aas\" & yyyy & mm & q & "\0009\a11013.txt", False, ""
3 ACCESS中筛选指定的记录到新表中；
建立新宏，操作中选择RunSQL并在参数设置中填写正确的SQL语句，执行有效后保存。接着通过工具——宏——将宏转换为VBA代码。根据实际需求将代码编写如下：（定义H为SQL语句）
H = "select * into " & I & " from " & timeyy & " WHERE ((([" & timeyy & "].帐号)= """ & I & """));"
DoCmd.RunSQL (H)
其中I为ACCESS表中某字段第一条记录的值。通过如下代码实现：
Dim b, c, d, e, f, G, H, j As Variant
Dim I As String
Set b = DBEngine.Workspaces(0).Databases(0)
Set c = b.TableDefs(1)
Set d = c.Fields(1)
Set e = CurrentDb.OpenRecordset("select * from qq")
j = 0
For j = 0 To 1
e.Move j
Set f = e("帐号")
I = f.Value
NEXT
4 将产生的新表按指定格式另存为TXT文件
参考导入TXT文件。
通过编辑由宏编译过来的VBA代码，在加入循环语句，基本完成了工作的自动化。
经过这个过程，一直抱怨ACCESS中没有提供录制宏功能的你发现通过将宏转化为VBA代码已经让你窥视了VBA FOR ACCESS的世界。而且ACCESS提供了近百条的宏，一一解读后，你俨然戴上高手的光环。GOOD LUCK!!
（文中例，见EXCEL HOME论坛。感谢给予帮助的朋友！）
朱斌
2003/8/14
附录完整代码：
Sub 解压缩单全()
On Error Resume Next
Dim Rarexe As String 'WINRAR执行文件的位置
Dim Source As String ' 解压缩前的原始文件
Dim Target As String ' 解压缩后的目标文件
Dim FileString As String 'Shell指令中的字符串
Dim Result As Long
Dim timeyy, yyyy, mm, dd, q As Variant
Rarexe = "C:\program files\winrar\winrar"
timeyy = InputBox("输入开始解压时间按YYYYMMDD格式", "北京路营业室")
yyyy = Left(timeyy, 4)
mm = Mid(timeyy, 5, 2)
dd = Right(timeyy, 2)
q = dd
Source = "C:\mfbreport\zipfiles\" & yyyy & mm & q & "_3602-0009"
'MsgBox (q)
FileString = Rarexe & " x " & " -o+ " & Source & " " & "?11013.txt" & " " & "c:\aas\"
Result = Shell(FileString, vbHide)
DoCmd.DeleteObject acTable, timeyy
DoCmd.TransferText acImportFixed, "A11013 链接规格", _
yyyy & mm & q, "c:\aas\" & yyyy & mm & q & "\0009\a11013.txt", False, ""
Dim b, c, d, e, f, G, H, j As Variant
Dim I As String
Set b = DBEngine.Workspaces(0).Databases(0)
Set c = b.TableDefs(1)
Set d = c.Fields(1)
Set e = CurrentDb.OpenRecordset("select * from qq")
'G = InputBox("输入时间按YYYYMMDD格式", "北京路营业室")
j = 0
For j = 0 To 1
e.Move j
Set f = e("帐号")
'MsgBox (f.Value)
I = f.Value
H = "select * into " & I & " from " & timeyy & " WHERE ((([" & timeyy & "].帐号)= """ & I & """));"
'MsgBox (H)
DoCmd.RunSQL (H)
DoCmd.TransferText acExportDelim, "A11013 导出规格g", I, "f:\qtsj\" & I & timeyy & ".txt", True, ""
DoCmd.DeleteObject acTable, I
Next
End Sub
[此贴子已经被作者于2003-8-14 13:11:06编辑过] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2003-8-14 12:52
发表于 2011-11-3 20:03
