Question

我想用VB中的2下划线区域替换硬代码，这样它就可以自动使用代码获取excel文件，并将电子表格传输到具有相同字段的Ms-Access表中。 IT应该能够使用MS-Access中的vb代码自动执行此功能。

Dim fso As Object  'FileSystemObject
Dim f As Object  'File
Dim strTempPath As String
Dim objExcel As Object  'Excel.Application
Dim objWorkbook As Object  'Excel.Workbook
Const TemporaryFolder = 2

On Error Resume Next
StrSQL = "DELETE * FROM bed_code_tbl"
DoCmd.SetWarnings False
DoCmd.RunSQL StrSQL

Set fso = CreateObject("Scripting.FileSystemObject")  'New FileSystemObject
strTempPath = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName & "\"
fso.CreateFolder strTempPath
'------------------------------------------------------

Set f = fso.GetFile("C:\Users\johnpfe\Documents\Bed_code_tbl.xlsx")
fso.CopyFile f.Path, strTempPath & f.Name
'--------------------------------------------------------

Set objExcel = CreateObject("Excel.Application")  ' New Excel.Application
Set objWorkbook = objExcel.Workbooks.Open(strTempPath & f.Name)
objWorkbook.ActiveSheet.Range("A1:C100").Select
objWorkbook.Save
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "bed_code_tbl", 
strTempPath & f.Name, True

fso.DeleteFile strTempPath & f.Name
fso.DeleteFolder Left(strTempPath, Len(strTempPath) - 1)

Set f = Nothing
Set fso = Nothing

End Sub ＆＃39; ---------------------------------------------- ------------------------

Answer 1

我假设您正在尝试查找当前用户的文档文件夹。您可以使用eviron（）函数。如果您按照这些链接进行更多操作。

http://msdn.microsoft.com/en-us/library/office/gg264486(v=office.15).aspx http://www.tek-tips.com/faqs.cfm?fid=4296

Dim fso As Object  'FileSystemObject
Dim f As Object  'File
Dim strTempPath As String
Dim objExcel As Object  'Excel.Application
Dim objWorkbook As Object  'Excel.Workbook
Const TemporaryFolder = 2

On Error Resume Next
strSQL = "DELETE * FROM bed_code_tbl"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL

Set fso = CreateObject("Scripting.FileSystemObject")  'New FileSystemObject
strTempPath = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName & "\"
fso.CreateFolder strTempPath
'------------------------------------------------------

Set f = fso.GetFile(Environ("UserProfile") & "\Documents\Bed_code_tbl.xlsx")
fso.CopyFile f.Path, strTempPath & f.NAME
'----------------------------------------------------------------------

Answer 2

您可以获取您的访问文件的文件夹位置。并相对于该位置放置创建的文件。

或者询问用户该位置。

如何在Access VBA中自动化文件夹位置和文件名？

2 个答案: