Function findFilePath()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select a file."
.Filters.Clear
.Filters.Add "All Files", "*.*"
If .Show = True Then
findFilePath = .SelectedItems(1)
End If
End With
End Function
Private Function findConnStr(fileEx As String, filePath As String)
Select Case fileEx
Case "xlsx"
findConnStr = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filePath & ";" & _
"Extended Properties='Excel 12.0 Xml;" & _
"HDR=YES';"
Case "xlsm"
findConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filePath & ";" & _
"Extended Properties='Excel 12.0 Macro;HDR=YES';"
End Select
End Function
Sub ImportEAMexport()
Dim filePath As String: filePath = findFilePath
If filePath = "" Then Exit Sub
Dim fileEx As String: fileEx = Right(filePath, Len(filePath) - InStrRev(filePath, "."))
Dim shtName As String
Dim cFile As ADODB.Connection
Dim rs As ADODB.Recordset
Set cFile = New ADODB.Connection
Select Case fileEx
Case "csv"
nameFile = Dir(filePath)
filePathLoc = Left(filePath, InStrRev(filePath, "\"))
cFile.ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePathLoc & ";Extensions=asc,csv,tab,txt;"
cFile.Open
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cFile
.Source = "SELECT * FROM [" & nameFile & "]"
.Open
End With
Case Else
cFile.ConnectionString = findConnStr(fileEx, filePath)
cFile.Open
upload_frm.sht_list.Clear
Set rsSht = cFile.OpenSchema(adSchemaTables)
Do While Not rsSht.EOF
upload_frm.sht_list.AddItem rsSht.Fields("TABLE_NAME").Value
rsSht.MoveNext
Loop
rsSht.Close
If upload_frm.sht_list.ListCount > 1 Then
upload_frm.Show
shtName = upload_frm.selsht
Else
shtName = upload_frm.sht_list.List(0)
End If
Set rs = New ADODB.Recordset
On Error GoTo rsError
With rs
.ActiveConnection = cFile
.Source = "SELECT [Work Order], [Organization], [Equipment], [Equipment Description], [PM Code], [Description], 'R',[Department], 'V', [1 - WO Owner], '', '', '', [Sched# Start Date], [Sched# End Date], '+', '+' FROM [" & shtName & "]"
.Open
End With
On Error GoTo 0
End Select
clearTable
toSched.Range("B3").CopyFromRecordset rs
rs.Close
cFile.Close
schedblock = "=IFERROR(INDEX(SCHED_BLOCK[2 Sched Block],MATCH([@[Unique Code (Do Not Transfer to Upload Template)]],SCHED_BLOCK[Unique Code (autofill)],0)),"""")"
shift = "=IFERROR(INDEX(TECH_INFO[SHIFT CODE],MATCH([@[1 WO Owner]],TECH_INFO[TECH LOGIN],0)),"""")"
super = "=IFERROR(INDEX(TECH_INFO[SUPERVISOR],MATCH([@[1 WO Owner]],TECH_INFO[TECH LOGIN],0)),"""")"
lbr = "=IFERROR(INDEX(SCHED_BLOCK[AVG LABOR FOR PM,EQUIP, AND ORG],MATCH([@[Unique Code (Do Not Transfer to Upload Template)]],SCHED_BLOCK[Unique Code (autofill)],0)),"""")"
Unicode = "=CONCATENATE([Equipment],""."",[PM Code])"
Range("l3") = schedblock
Range("m3") = shift
Range("n3") = super
Range("s3") = lbr
Range("t3") = Unicode
Exit Sub
rsError:
MsgBox "Could not import selected sheet. Check if selected sheet has the correct layout items and try again."
End Sub
Sub clearTable()
With toSched.ListObjects("ToScheduleTbl")
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
End Sub