View Full Version : 'm looking for the script that will do this function Automatically

2014-03-26, 04:07 PM
I need a substitute code for the codes "BETWEEN THE 2 UNDERLINES BELOW" so that it can fetch the directory automatically and transfer the spreadsheet to MS-ACCESS AUTOMATICALLY, instead of hard coding the C:\directory path.
I'm looking for the script that will do this function AUTOMATICALLY. THANKS. IT'S URGENT!!

Private Sub Command_ImportSpreadsheet_Click_Click()

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

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)
Set objWorkbook = Nothing
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