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