西安喜来登大酒店洋妞:守望麥田的Excel & VBA — Windows Live

在上两节中已经详细介绍了FileSystemObject对象的一些属性及方法。那么在这一节里，我们将举例说明如何使用VBA在Excel与文本文件中的导入导出。假设我们有如下数据表及文本文件：
 
现在要实现在这两个文件中的数据按指定的格式进行导入导出。下面我们就先进行将EXCEL数据表中的内容导出到testfile.txt中，并按图中的格式显示。
一、导出到文本文件的示例代码：
Sub Export2TxtFile()Dim fso As Object, sFile As Object, blnExist As BooleanDim iRow As Integer, FileName As StringSet fso = CreateObject("Scripting.FileSystemObject") '创建FileSystemObject对象FileName = "C:\FSOTest\testfile.txt" '指定文本文件名Check_FileExist:blnExist = fso.FileExists(FileName) '判断文件是否存在If blnExist ThenIf MsgBox("指定的数据文件已存在，是否覆盖原文件？", _vbExclamation + vbYesNo, "提示信息") = vbNo Then'如果不覆盖原文件，则要求指定文件名FileName = Application.InputBox("请输入文件名：")If FileName = "False" Then FileName = Sheet1.Name & "!$A$1"FileName = "C:\FSOTest\" & FileName & ".txt"GoTo Check_FileExist '再次检查文件是否存在Else '如果是，则先删除原文件fso.DeleteFile (FileName)End IfEnd IfSet sFile = fso.CreateTextFile(FileName)sFile.WriteLine ("[" & Sheet1.Range("A1").Value & "]") '写入第一行数据sFile.WriteBlankLines (1) '写入一个空白行For iRow = 2 To Sheet1.Range("A65536").End(xlUp).Row'从单元格A2开始读取数据，到数据表结尾，写入到文本文件中sFile.WriteLine (Sheet1.Cells(iRow, 1).Value _& "|" & Sheet1.Cells(iRow, 2).Value _& "|" & Sheet1.Cells(iRow, 3).Value _& "|" & Sheet1.Cells(iRow, 4).Value)Next iRowIf MsgBox("文件已导出。是否打开该文件？", vbYesNo + vbInformation) = vbYes ThenShell ("NotePad.exe " & FileName) '打开文本文件End IfEnd Sub
二、将文本文件导入到Excel数据表中：
Sub ImportFromTextFile()Dim fso As Object, sFile As Object, blnExist As BooleanDim FileName As String, LineText As Variant, i As Integer, iCol As IntegerConst ForReading = 1Set fso = CreateObject("Scripting.FileSystemObject") '创建FileSystemObject对象FileName = "C:\FSOTest\testfile.txt" '指定文本文件名blnExist = fso.FileExists(FileName) '判断文件是否存在，如果不存在，则退出过程If Not blnExist Then MsgBox "文件不存在！": Exit SubSet sFile = fso.OpenTextFile(FileName, ForReading) '创建并打开名为sFile的TextStream对象'读取第一行数据Sheet2.Range("A1").Value = Replace(Replace(sFile.ReadLine, "[", ""), "]", "")sFile.SkipLine '跳过第二行的空行i = 2 '设置输入单元格的起始行号Do While Not sFile.AtEndOfStream '如果不是文本文件的尾端，则读取数据LineText = Split(sFile.ReadLine, "|") '拆分读取到的数据到数组中For iCol = LBound(LineText) To UBound(LineText) '从数组中读取数据并写入对应的单元格Sheet2.Cells(i, iCol + 1).Value = LineText(iCol)Next iColi = i + 1 '滚动到下一个单元格行Loop'#这里可以加入设置单元格格式的代码sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
在这连续三篇文章中，分别简单介绍了FileSystemObject对象、TextStream对象的一些属性、方法以及如何在EXCEL与文本文件之间的数据导出。在这篇的文本文件读写操作的举例只作一个抛砖引玉的作用，如果网友发现有更加强大的文本文件的导入导出方法，别忘了跟我分享哦。
11:29 |固定链接 |查看引用通告 (1) |Excel VBA
11月13日
VBA使用FileSystemObject将读取或写入文本文件(二)
在上一节“VBA使用FileSystemObject将读取或写入文本文件(一)”中我们详细介绍了如何创建一个FileSystemObject对象及其对象。那么，在这一节里，将详细介绍FileSystemObject对象在创建或打开文本文件后返回的TextStream对象的一些属性及方法。
三、FileSystemObject对象返回的TextStream对象的属性及方法说明：
创建TextStream对象示例：
Dim sFile As Object, fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.CreateTextFile("C:\TestFile.txt")
示例中的sFile便为TextStream对象。
(一)TextStream属性：
1、Line属性：只读属性，返回一个TextStream文件中的当前行号。文件初次打开后，在写任何东西之彰，Line的值为1。
语法：object.Line
2、AtEndOfStream属性：只读属性，如果文件指针在TextStream文件末尾，则返回True；否则返回False。
语法：object.AtEndOfStream
3、AtEndOfLine属性：只读属性，如果文件指针在TextStream文件行尾标记的前面，则返回True；否则返回False。
语法：object.AtEndOfLine
(二)TextStream方法：
1、WriteLine方法：写入一个指定的字符和换行符到一个TextStream文件中。
语法：object.WriteLine([string])
Object:必需的。表示一个TextStream对象的名字。
string:可选的。要写入文件的正文。如果省略，一个换行符被写入文件中。
示例：打开一个文本文件并在文本文件中写入一些字符。
Sub WriteLine()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForAppending, TristateFalse)sFile.WriteLine "WriteLine Test"sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
2、Write方法：写一个指定的字符串到一个TextStream文件中。指定的字符串被写入到文件中，在每个字符串之间没有插入空格或字符。使用WriteLine方法写入一个换行符或一个以换行符为结尾的字符串。
语法：object.Write(string)
object:必需的。为一个TextStream对象的名字。
string:必需的。要写到文件中的字符串。
示例：下列代码将一个字符串写入到文本文件中，并实现与WriteLine方法相同的效果，即加入空格或换行符。
Sub WriteTest()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForAppending, TristateFalse)sFile.Write "Write Test" & vbTab & vbCrLf '同时加入一个Tab位及一个换行符sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
3、ReadLine方法：从一个TextStream文件读取一整行(到换行符但不包括换行符)并返回得到的字符串。
语法：string=object.ReadLine
string:返回的字符串。
object:一个TextStream对象。
示例：打开一个文本文件，并读取内容。
Sub ReadLine()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForReading)MsgBox sFile.ReadLinesFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
4、Read方法：从一个TextStream文件中读取指定数量的字符并返回得到的字符串。
语法：object.Read(characters)
object:必需的。表示为一个TextStream对象的名字。
characters:必需的。从文件中要读取的字符数。
示例：从一个打开的文本文件中读取5个字符。
Sub ReadTest()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForReading)MsgBox sFile.Read(5)sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
5、Close方法：关闭一个打开的TextStream文件。
语法：object.Close
6、WriteBlankLines方法：写入指定数量的换行符到一个TextStream文件中。
语法：object.WriteBlankLines(lines)
object:必需的。指一个TextStream对象的名字。
lines:必需的。要写入的换行符数量。
示例：在一个打开的文本文件中写入两个空行。
Sub WriteBlankLines()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForAppending)sFile.WriteBlankLines (2)sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
7、SkipLine方法：当读一个TextStream文件时跳过下一行。跳过一个是指读取放弃一行中的所有字符，一直到并包括该行的换行符。如果读的文件没有打开，则产生一个错误。
语法：object.SkipLine
8、Skip方法：当读一个TextStream文件时跳过指定数量的字符。跳过的字符将不被读取。
语法：object.Skip(characters)
object:必需的。表示一个TextStream对象的名字。
characters:必需的。当读文件时要跳过的字符的数量。
好了。这一节中介绍了TextStream对象的一些属性及方法。到这一节为止，我们就已经基本掌握了在VBA中如何使用FileSystemObject来读写文本文件的方法了。在接下来的一节里，我们将学习如何将文本文件中的数据读取到Excel中，及如何将Excel单元格中的数据写入到指定的文本文件中。
23:38 |阅读评论 (1) |固定链接 |查看引用通告 (1) |Excel VBA
VBA使用FileSystemObject将读取或写入文本文件(一)
有时，我们需要将一个文本文件中的数据读取到Excel单元格中，或将指定单元格的内容按指定的格式导出到文本文件中，这时，我们就需要使用Scripting.FileSystemObject对象来进行操作。在接下来的几篇里我们介绍如何使用FileSystemObject对象操作文本文件的。工欲善其事，必先利其器，那么我们就先花几篇文章来详细介绍下FileSystemObject对象。
一、如何创建FileSystemObject对象
在VBA中，是通过CreateObject函数返回FileSystemObject对象。
示例：
Dim fso As ObjectSet fso=CreateObject("Scripting.FileSystemObject")
二、FileSystemObject主要方法介绍
1、CreateTextFile方法：用于创建一个指定文件名，并返回一个可操作的TextStream对象。
语法：object.CreateTextFile(filename[,overwrite[,unicode]])
参数 说明
object 必需的。为一个FileSystemObject对象的名字
filename 必需的，一个带路径的字符串表达式，为创建的文件
overwrite 可选的。Boolean值，如果为True表示覆盖已存在的文件，False表示不能覆盖。默认值为False。
unicode 可选的。Boolean值，表示文件是作为一个Unicode文件创建的还是作为一个ASCII文件创建的。如果为True则表示作为Unicode文件创建，False表示作为ASCII文件创建。默认值为False。
示例1：在C:\FSOTest\中创建一个名为testFile的文本文件，并写入一行“CreateTextFile Test”：
Sub CreateFile()Dim sFile As Object, FSO As ObjectSet FSO = CreateObject("Scripting.FileSystemObject")Set sFile = FSO.CreateTextFile("C:\FSOTest\TestFile.txt",True)sFile.WriteLine ("CreateTextFile Test")sFile.CloseSet sFile = NothingSet FSO = NothingEnd Sub
2、DeleteFile方法：用于删除一个指定的文件。如果指定的文件不存在，则返回一个错误信息。
语法：object.DeleteFile(filespec[,force])
参数 说明
object 必需的。为一个FileSystemObject对象
filespec 必需的。要删除文件的名字。可以在最后的路径部件中包含通配符
force 可选的。Boolean值，如果要删除具有只读属性设置的文件，则为True。如果不能删除具有只读属性设置的文件，则为False。默认值为False
示例2：删除示例1中创建的文本文件。
Sub DeleteFile()Dim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")fso.DeleteFile ("C:\FSOTest\TestFile.txt")End Sub
3、FileExists方法：判断指定的文件是否存在。如果存在，则返回True，若不存在，则返回False
语法：object.FileExists(filespec)
参数 说明
object 必需的。为一个FileSystemObject对象
filespec 必需的。要确定是否存在的文件名。如果认为文件不在当前文件夹中，必须提供一个带完整的路径说明。
示例3：判断“C:\FSOTest\”中是否存在文件“testfile.txt”：
Sub FileExist()Dim fso As Object, blnExist As BooleanSet fso = CreateObject("Scripting.FileSystemObject")blnExist = fso.FileExists("C:\FSOTest\testfile.txt")MsgBox blnExistEnd Sub
4、OpenTextFile方法：打开一个指定的文件并返回一个TextStream对象，该对象可能于对文件进行读操作或追加操作。
语法：object.OpenTextFile(filename[,iomode[,create[,format]]])
参数 说明
object 必需的。始终是一个 FileSystemObject 的名字
filename 必需的。为一个文件名，包含完整路径说明
iomode 可选的。表示输入/输出方式。可为两个常数之一：ForReading或 ForAppending。
create 可选的。Boolean 值，它表示如果指定的 filename 不存在是否可以创建一个新文件。如果创建新文件，其值为 True。若不创建文件其值为 False。缺省值为 False。
format 可选的。三种 Tristate 值之一，用于指示打开文件的格式。如果省略，则文件以 ASCII 格式打开。
参数iomode可以设置为以下值：
常数 值 说明
ForReading 1 打开一个只读文件。不能对此文件进行写操作
ForWriting 2 打开一个可读写操作的文件，并删除原有文本内容
ForAppending 8 打开一个文件并写到文件的尾部
参数format可以设置为以下值：
常数 值 说明
TristateUseDefault -2 使用系统缺省打开文件
TristateTrue -1 以Unicode格式打开文件
TristateFalse 0 以ASCII格式打开文件
示例4：本例说明了使用OpenTextFile方法打开testfile.txt文件，并添加文字“OpenTextFile Test”：
Sub OpenTextFile()Dim fso As Object, sFile As ObjectConst ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0Set fso = CreateObject("Scripting.FileSystemObject")Set sFile = fso.OpenTextFile("C:\FSOTest\testfile.txt", ForAppending, TristateFalse)sFile.Write "OpenTextFile Test"sFile.CloseSet fso = NothingSet sFile = NothingEnd Sub
下一节中，我们将介绍FileSystemObject对象返回的TextStream对象的属性与方法，并示例如何对文本文件进行读写操作。
23:13 |固定链接 |查看引用通告 (1) |Excel VBA
将当前工作簿备份为RAR文件
我们在日常工作中，有些EXCEL文件比较重要，又或者是需要将其进行打包发送给其他同事时，我们一般是先将当前打开的工作簿关闭后，再打开WINRAR将其进行压缩，那么，可不可以用VBA代码直接将当前打开的文件进行备份呢？好了。废话少说，下面直接贴上代码：
Sub SaveAsRAR()Dim RarPath As String, FilePath As String, FileName As String,Dim sName As String, Password As String, ExtensionName As StringDim fd As FileDialog, fso As Object, TargetFile As String, ps, HasProcess As BooleanApplication.ScreenUpdating = FalseIf ActiveSheet Is Nothing Then Exit SubIf TypeName(ActiveSheet) <> "Worksheet" Then Exit SubSet fso = CreateObject("Scripting.FileSystemObject")FileName = ActiveWorkbook.NamesName = Split(FileName, ".")(0) '获得文件名ExtensionName = fso.GetExtensionName(FileName) '获取文件的扩展名Set fd = Application.FileDialog(msoFileDialogFolderPicker)Folder_Select:If fd.Show ThenFilePath = fd.SelectedItems(1)If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"ElseGoTo Exit_SubEnd IfIf FilePath & FileName = ActiveWorkbook.FullName ThenMsgBox "不能备份到当前文件的目录中", vbInformation, "备份工作簿"GoTo Folder_SelectEnd IfActiveWorkbook.SaveCopyAs FilePath & FileName'询问是否给压缩文件加密If MsgBox("是否加密RAR文件？", vbInformation + vbYesNo, "备份工作簿") = vbYes ThenPassword = Application.InputBox(prompt:="请设置压缩密码：", Title:="备份工作簿", Type:=1)If Password = "False" ThenRarPath = """" & ThisWorkbook.Path & "\rar.exe"" A -EP -DF "ElseRarPath = """" & ThisWorkbook.Path & "\rar.exe"" A -EP -DF -P" & Password & " "End IfElseRarPath = """" & ThisWorkbook.Path & "\rar.exe"" A -EP -DF "End IfRarPath = RarPath & """" & FilePath & sName & ".rar"" "TargetFile = """" & FilePath & FileName & """"'开始压缩文件Call Shell(RarPath & TargetFile, vbHide)Try_Again:For Each ps In GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_If UCase(ps.Name) = "RAR.EXE" Then HasProcess = True'如进程未结束，则将HasProcess标志为True表明文件未压缩完Next psIf HasProcess ThenGoTo Try_AgainElseMsgBox "文件已备份到 " & FilePath, vbInformation, "备份工作簿"GoTo Exit_SubEnd IfExit_Sub:Application.ScreenUpdating = TrueSet fso = NothingSet fd = NothingEnd Sub
在这段代码演示中，我是将WINRAR的RAR.EXE文件放到与工作簿相同的目录中的，在实际中，我们可以将ThisWorkbook.Path更改为WINRAR的安装目录中。
RAR.EXE参数说明：rar.exe <命令> -<开关1> –<开关N> <压缩文件> <文件>
本例中，命令 A 表示添加文件到压缩文件；-EP表示从名称中排除路径，即：如果需要压缩文件是存放在“D:\Backup\1.txt”中的，如果没有-EP这个开关，RAR则会将需要压缩的文件从根目录开始到当前文件夹名一起压缩到本压缩文件中；-DF 表示压缩完成后删除原文件；-P表示给压缩文件加上密码，方式为：-P[Password]，如需要给压缩文件加上密码123，则-P123；综上，则将D:\Backup\1.txt添加到压缩文件中的命令参数写成如下：
RAR.EXE A –EP –DF –P123 "D:\Backup\1.rar" "D:\Backup\1.txt"
为什么要进行进程判断？这是因为如果需要压缩的文件比较大时，程序的代码已执行完毕，但文件却未压缩完毕，这就会造成文件压缩不成功的现象。
15:20 |固定链接 |Excel VBA
11月12日
使用Excel通过金蝶K3接口制作凭证
曾经在http://club.excelhome.net 中看过wangchao207同学在帖子http://club.excelhome.net/viewthread.php?tid=487202&extra=&page=1中提到过如何使用VBA来控制金蝶生成凭证，在翻查了一些金蝶自带的SDK帮助文件后，发现了可以用VBA控制金蝶生成凭证的方法及思路，供大家参考：
一、制作凭证所需的K3组件DLL文件：KDVBF.DLL，KFO10.DLL，EBCGL10.DLL，EBCGLV10.DLL，K3Login.DLL。这些组件都是金蝶公司公开的一些接口函数及方法。具体的用法大家可以到装有K3客户端的机子上查看：“%Programfiles%\Kingdee\K3ERP\KDSDK\SDKHELP\”
二、我们都知道，用K3系统制作凭证时，都是按照这样的顺序进行的：登录K3主控台>打开K3凭证界面>凭证录入。因此，在EXCEL中生成凭证也是按照这种顺序来进行的，不过所不同的是，在EXCEL中并不会出现K3主控台，只是调用了K3Login组件来检查用户是否有权限及取得连接字符串，然后在EXCEL里按上表中的格式输入必要数据后，就直接调用K3凭证修改界面进行进一步的操作。好了，废话少说，切入正题，写代码。
三、代码：打开EXCEL的VBE窗口，新建一个模块modVoucher，同时添加一个MParse模块。MParse模块的代码在这里就省略不写了，这个模块的代码可自行到%ProgramFiles%\Kingdee\K3ERP\KDSDK\SDKHELP\中的“用户登录参考手册.PDF”中查看。
1、定义全局模块：
Option ExplicitPublic HasConn As BooleanPublic CnString As StringPublic UserName As StringPublic AcctName As String
2、用户登录：继续在modVoucher中添加代码
Public Sub Login()Dim objK3Login As ObjectSet objK3Login = CreateObject("K3Login.ClsLogin")If Not objK3Login.CheckLogin ThenHasConn = False '设置为未连接状态MsgBox "未登录账套"GoTo Exit_SubEnd IfHasConn = True '设置为已连接状态UserName = objK3Login.UserName '取得用户名AcctName = objK3Login.AcctName '取得登录的账套名MParse.ParseString objK3Login.PropsString '分析连接字符串CnString = MParse.ConStr '取得连接字符串用于ADODB连接Exit_Sub:Set objK3Login = NothingEnd Sub
3、生成凭证头及凭证分录：
Public Function CreateVoucher() As ObjectDim Voucher As ObjectDim VoucherEntrys As ObjectDim VoucherDetail As ObjectDim i As Integer, EntryCount As IntegerSet Voucher = CreateObject("EBCGL.Voucher") '创建凭证对象Voucher.Construct Nothing, Nothing '清除凭证内容Voucher.GroupID = VoucherGroupID '凭证号关联的IDVoucher.VoucherDate = Format(VoucherDate, "yyyy-MM-dd") '凭证日期Voucher.TransDate = Format(TransDate, "yyyy-MM-dd") '业务日期Voucher.Number = VoucherNumber '凭证号Voucher.Attachments = VoucherAttachments '附件数Set VouhcerEntrys = Voucher.Entries '创建凭证分录体'假设凭证有3条分录，其中第2、第3条分录是带有核算项目EntryCount = 3For i = 1 To EntryCountVoucherEntrys.Add '添加一个凭证分录With VoucherEntrys.Entries(i).Explanation = VoucherExplanation '摘要.AccountNumber = AccountNumber '科目代码.CurrencyID = CurrencyID '币别内码ID.ExchangeRate = ExchangeRate '汇率.AmountFor = AmountFor '原币金额.MeasureUnitID = MeasureUnitID '数量单位ID.Quantity = Quantity '数量If .Quantity <> 0 Then .UnitPrice = .AmountFor / .Quantity Else .UnitPrice = 0 '单价.DC = DC '借或贷，0为贷，1为借If .DC = 1 Then '根据借贷来判断出借方本位币及贷方本位币.Amount = DebitAmount '借方本位币Else.Amount = CreditAmount '贷方本位币End IfIf Len(VoucherDetailItem) <> 0 Then '如果设定了核算项目，则添加核算项目Set VoucherDetail = .Details '设置分录的核算项目对象VoucherDetail.Add '添加核算项目VoucherDetail(VoucherDetail.Count).ItemClassID = ItemClassID '类别IDVoucherDetail(VoucherDetail.Count).ItemID = ItemID '核算项目IDEnd IfEnd WithNext iSet CreateVoucher = VoucherSet Voucher = NothingSet VoucherEntrys = NothingSet VoucherDetail = NothingEnd Function
以上所涉及到的VoucherGroupID，VoucherDate，TransDate，VoucherNumber，VoucherAttachments，VoucherExplanation，AccountNumber，CurrencyID，ExchangeRage，AmountFor，MeasureUnitID，Quantity，DebitAmount，CreditAmount，VoucherDetailItem，ItemClassID，ItemID分别设置到相关的单元格值就可以了。
4、显示凭证
Public Sub DisplayVoucher()Dim rel As KDVBF.Relevancy, Vch As Object, Voucher As ObjectDim Mode As Long, ReturnVoucherID As Long'这里可以加一些诸如检查凭证是否平衡，是否有凭证字等一些代码If Not HasConn Then MsgBox "请先登录账套后再生成凭证"Set Vch = CreateObject("Mvedit.MVoucherEdit") '创建凭证修改界面Mode = 0ReturnVoucherID = 0Set Voucher = CreateVoucherIf Voucher Is Nothing Then Exit SubSet rel = New KDVBF.Relevancy '建立输入对象Set rel.EditObject = Voucher '设置凭证数据对象到Rel参数rel.MultiEdit = False '是否允许多张凭证编辑Vch.LoadVoucher Mode, , rel, , ReturnVoucherID '显示凭证界面Set Vch = NothingSet Voucher = NothingSet rel = NothingEnd Sub
好了，到现在为止，一张凭证就已生成并显示在K3的凭证修改界面中了，现在你只需要做的只是再次检查数据是否有误，如果无误的话点击保存。
四、其它的一些获取数据的方法
1、根据凭证字获取凭证字的内码ID
Public Function VoucherGroupID(ByVal GroupName As String) As Long '获取凭证字IDDim GroupSet As Object, Group As ObjectSet GroupSet = CreateObject("EBCGL.VoucherGroupSet") '创建凭证字记录集Set Group = CreateObject("EBCGL.VoucherGroup") '创建凭证字Set Group = GroupSet.Item(GroupName) '从凭证号记录集中取得对应凭证字VoucherGroupID = Group.VoucherGroupGroupID '显示凭证号所对应的IDSet GroupSet = NothingSet Group = NothingEnd Function
2、根据币别名称获取币别内码ID
Public Function CurrencyID(ByVal CurrencyName As String) As LongDim CurrencySet As Object, Currencyx As ObjectSet CurrencySet = CreateObject("EBCGL.CurrencySet")Set Currencyx = CreateObject("EBCGL.Currencyx")For Each Currencyx In CurrencySetIf Currencyx.Name = CurrencyName Then CurrencyID = Currencyx.CurrencyIDNext CurrencyxSet CurrencySet = NothingSet Currencyx = NothingEnd Function
3、根据数量单位名称获取数量单位内码
Public Function MeasureUnitID(ByVal MeasureUnitName As String) As LongDim Conn As ADODB.ConnectionDim rst As ADODB.RecordsetDim strSQL As StringSet Conn = New ADODB.ConnectionWith Conn.ConnectionString = CnString.OpenEnd WithstrSQL = "SELECT FMeasureUnitID FROM t_MeasureUnit WHERE FName='" & MeasureUnitName & "'"rst.Open strSQL, ConnIf Not rst.EOF ThenMeasureUnitID = rst.Fields(0).ValueElseMeasureUnitID = 0End Ifrst.Close: Set rst = NothingConn.Close: Set Conn = NothingEnd Function
4、根据核算项目类别名称获取类别ID
Public Function ClassID(ByVal ItemClassName As String) As LongDim ItemClassSet As Object, ItemClass As ObjectSet ItemClassSet = CreateObject("EBCGL.ItemClassSet")Set ItemClass = CreateObject("EBCGL.ItemClass")For Each ItemClass In ItemClassSetIf ItemClass.Name = ItemClassName Then ClassID = ItemClass.ItemClassIDNext ItemClassSet ItemClassSet = NothingSet ItemClass = NothingEnd Function
5、根据核算项目代码及类别ID获取核算项目ID
Public Function ItemID(ByVal ItemNumber As String, ByVal ItemClassID As Long) As LongDim ItemSet As Object, lngItemID As LongSet ItemSet = CreateObject("EBCGL.ItemSet")lngItemID = ItemSet.ExistenceCheck(, ItemClassID, ItemNumber)ItemID = lngItemIDSet ItemSet = NothingEnd Function
五、一些与凭证相关的数据表，列出下面的一些关联表只是为了查询用，建议不要去修改表的内容。如果修改则可能造成不可估量的错误。
1、凭证头表：t_Voucher
2、凭证分录表：t_VoucherEntry
3、科目表：t_Account
4、币别表：t_Currency
5、数量单位表：t_MeasureUnit
6、核算项目表：t_Item,t_ItemClass