2014-03-26 20 views
-1

我想用VB代替VB中2個下劃線區域之間的硬編碼,以便它自動地用代碼取得excel文件並將電子表格傳送到具有相同字段的Ms-Access表格中。 IT應該能夠使用MS-Access中的vb代碼自動執行此功能。如何在Access VBA中自動化文件夾位置和文件名?

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 '--------------------------------------- -------------------------------

+1

替代*什麼*?簡單的答案是初始化一個字符串變量(可能在一個循環內),然後將該字符串變量設置爲所需的文件路徑。 –

+0

你可能想要'CreateObject(「Wscript.Shell」)返回的文件夾位置SpecialFolders(「Mydocuments」)'? – HansUp

回答

0

您可以獲取您的訪問文件的文件夾位置。並將創建的文件放置在該位置。

或者向用戶詢問位置。

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 
'---------------------------------------------------------------------- 
相關問題