我要做的是将我的按钮(我的表单上的导入按钮)映射到导入文本文件(文本文件实际上将在网络驱动器上)。这些文本文件是固定列。我对如何合并表单和模块以协同工作感到困惑。如何在表单上的按钮,调用此模块执行?此外,如果有更有效的方式导入这些固定的文本文件,我将不胜感激。
我目前为我的表单设置了以下VBA代码(将用于将文本文件导入我的Access数据库):
Private Sub cmdImport_Click()
On Error GoTo Click_Err
reportDate = Format(txtReportDate, "YYMMDD")
reportGenDate = Format(textReportDate, "YYYYMMDD")
rDate = txtReportDate
If Nz(txtReportDate, "") = "" Then
MsgBox "NOTICE! Please enter the Report Month you wish to Import."
Exit Sub
End If
DoCmd.Hourglass True
DoCmd.SetWarnings False
ImportAll
DoCmd.Hourglass False
DoCmd.SetWarnings True
MsgBox "Finished Importing!"
DoCmd.OpenQuery "query_Files_Loaded_CE", acViewNormal, acReadOnly
click_Exit:
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Sub
Click_Err:
DoCmd.Hourglass False
MsgBox "Error Detected: " & Err.Number & " - " & Err.Description, vbCritical, "Error"
Resume click_Exit
End Sub
对于我的模块(请原谅说明):
Option Compare Database
Public reportDate As String
Public reportGenDate As String
Public rDate As Date
Public Function Import2010()
'Used to import a date range
Dim funcDate As Date '
funcDate = #2/1/2016#
reportDate = Format(funcDate, "YYMM")
rDate = funcDate
'Basically Do While is a loop so what your doing here as long as the value of the date does not EQUAL 3/1/2016
'excute the nexxt line of code other wise exit this loop
Do While funcDate <> #3/1/2016#
DoCmd.SetWarnings False
'ImportAll
ImportFile "H3561"
'Msg Box reportDate
funcDate = DateAdd("m", 1, funcDate)
reportDate = Format(funcDate, "YYMM")
rDate = funcDate
Loop
DoCmd.SetWarnings True
End Function
Public Function ImportAll() ' Import button on FrmIMport
'A recordset is a selection of records from a table or query.
'Dim is short for the word Dimension and it allows you to declare variable names and their type.
'When you read data from the database in VBA, the result will be in a recordset (with the exception of scalar data).
Dim rs As Recordset
Dim sql As String
'This code loops through the recordset of all contracts and import files, as in it looks for
'Specific value based off a specific condition.
sql = "SELECT DISTINCT Contract FROM Contract_CE"
Set rs = CurrentDb.OpenRecordset(sql)
rs.MoveLast 'This method is used to move to the last record in a Recordset object. It also makes the last record the current record.
rs.MoveFirst 'This method is used to move to the first record in a Recordset object. It also makes the first record the current record.
If rs.RecordCount > 0 Then
Do While rs.EOF = False
ImportFile rs!contract
rs.MoveNext 'This method is used to move to the next record in a Recordset object. It also makes the "next" record the current record.
Loop
End If
End Function
Public Function ImportFile(contract As String)
Dim filepath As String
Dim tempPath As String
Dim zipFile As String
'Set paths
filepath = "\\XXXXX\XXXXX\XXXXX\XXXXXXX"
'tempPath =
tempPath = "\\XXXXXX\XXXXX\XXXXX\XX"
'Find the file
zipFile = GetFile(filepath)
'check if file exists
If zipFile = "" Then
'DoCmd.Hourglass False
'MsgBox contract & " " & reportDate & " File could not be located."
'DoCmd.Hourglass True
LogFail (contract)
Exit Function
End If
'Clearing out existing Contract/ReportDate data from Table
DeleteContract (contract)
'Delete all files in temp folder
DeleteAllFiles (tempPath)
'UnzipFile txt to temp folder
UnZip filepath & zipFile, tempPath
'Get txt file namee
txtFile = Replace(zipFile, ".zip", ".txt")
DoEvents
Sleep 10000 'wait for file to unzip
'The TransferText method is used to import/export text between the current Access database or Access project and a text file located
'externally to your database. You can also use this command to link to data in a text file. Additionally, can import from, export to, and link to a table in an HTML file.
'Importing txt file
'Depcreated - Alec Johnson - 5/12/2016 - Created new import spec
'DoCMD.TransferText acImportFixed, "ImportSpec_COMPRPT", tempPath & txtfile, False
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False '<--does path go here?
'Update FileName
UpdateFileName (zipFile)
'Delete txt file from location
DeleteAllFiles (tempPath)
'Delete any Null records added to main table
DeleteNulls
'Log to table if successful
LogSuccess (contract)
End Function
Public Function DeleteAllFiles(path As String)
'Delete all files in this folder
On Error Resume Next
Kill path & "*.*"
End Function
Function UnZip(filename As String, destinationPath As String)
'FileSystemObject also called as FSO, provides an easy object based model to access computer’s file system.
'You simply have to create an instance of FileSystemObject in VBA and then you can generate files, read files, delete files,
'iterate though folders and do many other operations on your computer’s file system.
'Unzip file (s) to destination
Dim app As Object
Dim zipFile As Variant, unzipTo As Variant
zipFile = filename
unzipTo = destinationPath
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(unzipTo) Then
FSO.CreateFolder (unzipTo)
End If
'If you want to extract only file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.items("test.txt")
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(unzipTo).CopyHere oApp.Namespace(zipFile).Items
Set FSO = Nothing
End Function
Public Function GetFile(filepath As String) As String
Dim fileNamePart As String
Dim fCheck
fileNamePart = "COMPRPT_" + reportDate
fCheck = ""
fFound = ""
Set oFolder = CreateObject("scripting.filesystemobject").GetFolder(filepath)
For Each aFile In oFolder.Files
Set fCheck = aFile
If InStr(fCheck.Name, fileNamePart) Then
Set fFound = aFile
End If
Next
If fFound = "" Then
GetFile = ""
Else
GetFile = fFound.Name
End If
End Function
Public Function DeleteContract(contract As String)
Dim sql As String
sql = "Delete * FROM COMPRPT WHERE ContractNumber = '" & contract & "' AND ReportGenerationDate = '" & reportGenDate & "'"
DoCmd.RunSQL sql
End Function
Public Function LogSuccess(contract As String)
Dim sql As String
sql = "INSERT INTO FilesLoaded (Contract, ReportDate, Loaded) VALUES ('" & contract & "', #" & rDate & "#, -1)"
DoCmd.RunSQL sql
End Function
Public Function DeleteNulls()
Dim sql As String
sql = "DELETE * FROM COMPRPT WHERE ContractNumber Is Null"
DoCmd.RunSQL sql
End Function
Public Function lksjdlaskjd()
ImportFile "H0351", #4/1/2009#
End Function
以下是文本文件的示例:
答案 0 :(得分:4)
如果我理解正确,你的问题就在于:
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False '<--does path go here?
但你已解压缩到tempPath
,所以应该是
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", tempPath & txtFile, False
使用网络文件通常比使用本地文件慢,所以我会将tempPath
作为本地路径。
修改:请注意,要使tempPath & txtFile
有效,tempPath
必须以\
结尾:
tempPath = "C:\XXXXXX\XXXXX\XXXXX\XX\"
您的代码存在其他问题:
1 - 首先,请使用Option Explicit
,有关详细信息,请参阅this question。
您有多个未声明或拼写错误的变量,例如fFound
和oApp
与app
。
2 - 这是一个等待发生的错误:
reportDate = Format(txtReportDate, "YYMMDD")
reportGenDate = Format(textReportDate, "YYYYMMDD")
将第二个文本框命名为txtReportGenDate
,而不是textReportDate
。
3 - 在ImportAll()
中,所有这些都不需要,因为您不使用RecordCount:
rs.MoveLast
rs.MoveFirst
If rs.RecordCount > 0 Then
4 - 这是错误的语法:
DeleteContract (contract)
它适用于单个参数,但对于带有&gt; 1个参数的潜艇将失败。
使用
DeleteContract contract
或
Call DeleteContract(contract)
或
retVal = DeleteContract(contract)
答案 1 :(得分:2)
我对如何合并表单和模块以协同工作感到困惑。表单上的按钮如何调用此模块执行?
对象和程序可以被视为公共或私人。例如: -
Private Sub Test
Msgbox "Hello World!"
End Sub
是私有的,这意味着只有它的父母可以调用它。为了详细说明这一点,让我们创建两个模块Module1
和Module2
,并将private sub Test
放在Module1
中。
同样在Module1
我们另一个私人程序: -
Private Sub Test2
Msgbox "Back at ya"
End Sub
Module1
是Test
和Test2
的父级,因为他们拥有相同的父级,可以互相运行: -
Private Sub Test
Msgbox "Hello World!"
Test2 'This will run the Test2 procedure
End Sub
Module2
无法运行其中任何一个,因为它没有查看它们,它没有参与。
现在,如果我们将Test
更改为公开(Public Sub Test
),Module2
将能够看到它已曝光。
在Module2
我们有: -
Public Sub Test3
Module1.Test 'This will run as it is public
Module1.Test2 'This will fail as it is private
End Sub
也有这种方式从第二单元中调用它们: -
Public Sub Test3
Test 'This will run as it is public
Test2 'This will fail as it is private
End Sub
虽然这不明确并且可能导致错误和混淆,您可以在Module2
中创建一个也称为Test
的过程,您如何知道哪个测试Test3
正在运行?为了安全起见,您明确将其位置写为Module1.Test
。