All, Thank you. Although its crude and a better way to do it. I have the code doing what I want it to do. With the exception of killing the excel that stays open hidden in the background. Killing it manually in task Manager at the moment.
Code:
Private Sub OpenExcel_Click()Dim varItem As Variant, lngCnt As Long
Dim ObjXL As Object, ObjWk As Object, f As Object
Dim colWSht As Collection, WkBk As Workbook, WkSht As Worksheet
Dim blnHasFieldNames As Boolean, blnXL As Boolean, blnReadOnly As Boolean
Dim strFile As String, strFile2 As String, strFolder As String, strPathFile As String, strPathFile2 As String, strTable As String
' Establish an EXCEL application object
On Error Resume Next
Set ObjXL = GetObject(strPathFile, "Excel.Application")
If Err.Number <> 0 Then
Set ObjXL = CreateObject("Excel.Application")
blnXLL = True
End If
Err.Clear
On Error GoTo 0
' True if the first row in EXCEL worksheet has field names
blnHasFieldNames = True
' Opens Selection Box to select file
Set f = Application.FileDialog(1)
f.AllowMultiSelect = False
If f.Show Then
For Each varItem In f.SelectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
Next
End If
If strFile = "" Then
MsgBox "User pressed CANCEL"
Exit Sub
End If
strTable = Left(strFile, InStr(strFile, ".") - 1) ' Table name without the .xlsx into which the data are to be imported
strPathFile = strFolder & strFile
strFile2 = "X_" & strFile
blnReadOnly = False ' open EXCEL file in write mode
' Open the EXCEL file and read the worksheet names into a collection
Set colWSht = New Collection
Set WkBk = ObjXL.Workbooks.Open(strPathFile, , blnReadOnly)
Set ObjWk = ObjXL.Workbooks.Open(strPathFile, , blnReadOnly)
For lngCnt = 1 To ObjWk.Worksheets.Count
colWSht.Add ObjWk.Worksheets(lngCnt).Name
Set WSht = ObjWk.Worksheets(lngCnt)
With WSht
.Columns(8).Delete
.Columns(7).Delete
.Columns(6).Delete
.Columns(2).Delete
.Range("F1:Z1").EntireColumn.Delete
.Range("A1").EntireColumn.Insert
.Range("A1:A4").EntireRow.Delete
.Cells(1, 1) = "SystemOwner"
.Cells(1, 2) = "IPAddress"
.Cells(1, 3) = "URN"
.Cells(1, 4) = "RoleName"
.Cells(1, 5) = "SystemType"
.Cells(1, 6) = "Notes"
.Range("A2:A256").Cells.Value = WSht.Name
End With
Next lngCnt
WkBk.SaveAs strFolder & strFile2
strPathFile2 = strFolder & strFile2
Set ObjWk = ObjXL.Workbooks.Open(strPathFile2, , blnReadOnly)
' Import the data from each worksheet into the table
For lngCnt = 5 To colWSht.Count
DoCmd.TransferSpreadsheet 0, 10, strTable, strPathFile2, blnHasFieldNames, colWSht(lngCnt) & "$A1:I262"
Debug.Print colWSht(lngCnt) & " " & lngCnt
Next lngCnt
'Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set ObjWk = Nothing
Set ObjXL = Nothing
Set colWSht = Nothing ' Delete the collection
Set WkBk = Nothing
Set WSht = Nothing
Excel.Application.Quit
Kill strFile2
If blnXL = True Then ObjXL.Quit
End Sub