Thanks the lengthy code is below. Its the ImportGL function
Option Explicit
Public sItem As String
Sub MainFile()
MsgBox ("This import process may take up to 5 minutes. Please be patient and wait for the 'Imports Complete' message box.")
GetFolder
ImportGL
ImportCOA
ImportLD
ChangeDates
ImportPools
ImportSC
Worksheets("Start").Select
ActiveSheet.Move Before:=Sheets(1)
MsgBox ("Imports Complete")
End Sub
'sItem has name of folder
'navigate and save folder location as sItem
Function GetFolder() As String
Dim fldr As FileDialog
'Dim sItem As String
Dim oldGL As String
Dim newGL As String
Dim oldCOA As String
Dim newCOA As String
Dim oldPool As String
Dim newPool As String
Dim oldLD As String
Dim newLD As String
Dim oldSC As String
Dim newSC As String
Dim GLexist As String
Dim COAexist As String
Dim Poolexist As String
Dim LDexist As String
Dim SCexist As String
Dim GLflt As String
Dim LDflt As String
Dim COAflt As String
Dim Poolflt As String
Dim SCflt As String
Dim Anyflt As String
MsgBox ("Navigate to the folder that contains the 5 Deltek GCS Premier files.")
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
' MsgBox (sItem)
'flt files exist
GLflt = sItem & "\GL02GLF.flt"
LDflt = sItem & "\LD01LDF.flt"
COAflt = sItem & "\GL01COA.flt"
Poolflt = sItem & "\CT03CPF.flt"
SCexist = sItem & "\CT03CPF.flt"
Anyflt = sItem & ".flt"
' MsgBox (Anyflt)
'Both flt and txt files do not exist.
If Dir$(sItem & "\*.flt") = "" And Dir$(sItem & "\*.txt") = "" Then
MsgBox "The contractor files were not in the referenced folder. Please either change folder or move the files."
Exit Function
ElseIf Dir$(sItem & "\*.flt") = "" And Dir$(sItem & "\*.txt") <> "" Then
MsgBox "The files were already converted."
Exit Function
End If
'GL.txt exist already?
GLexist = sItem & "\GL02GLF.txt"
If GLexist = "" Then
MsgBox "GL file already converted."
Else
'change GL file extension
oldGL = sItem & "\GL02GLF.flt"
'MsgBox (oldGL)
newGL = sItem & "\GL02GLF.txt"
' MsgBox (newGL)
Name oldGL As newGL
End If
'Chart of Accounts exist already?
COAexist = sItem & "\GL01COA.txt"
If COAexist = "" Then
MsgBox "Chart of Accounts file already converted."
Else
'change chart of accounts extension
oldCOA = sItem & "\GL01COA.flt"
' MsgBox (oldCOA)
newCOA = sItem & "\GL01COA.txt"
Name oldCOA As newCOA
End If
'Pool file already exist?
Poolexist = sItem & "CT03CPF.txt"
If Poolexist = "" Then
MsgBox "Pool file already converted."
Else
'change indirect pool extension
oldPool = sItem & "\CT03CPF.flt"
' MsgBox (oldPool)
newPool = sItem & "\CT03CPF.txt"
Name oldPool As newPool
End If
'Labor file exist?
LDexist = sItem & "\LD01LDF.txt"
If LDexist = "" Then
MsgBox "Labor file already exists."
Else
'change labor distribution extension
oldLD = sItem & "\LD01LDF.flt"
' MsgBox (oldLD)
newLD = sItem & "\LD01LDF.txt"
Name oldLD As newLD
End If
'change service center extension
SCexist = sItem & "\CT15SCM.txt"
If SCexist = "" Then
MsgBox "Service Center file already exists."
Else
oldSC = sItem & "\CT15SCM.flt"
' MsgBox (oldSC)
newSC = sItem & "\CT15SCM.txt"
Name oldSC As newSC
End If
' Name sItem & "\GL02GLF.flt" As sItem & "\GL02GLF.txt"
'Name "C:\Users\jzellman\Documents\HQ\Projects\GCS Premier Import Button\Contractor Files\Navsys\GL02GLF.flt" As "C:\Users\jzellman\Documents\HQ\Projects\GCS Premier Import Button\Contractor Files\Navsys\GL02GLF.txt"
'outputfilename = CurrentProject.Path & "\Data.xls"
' MsgBox (outputfilename)
'Name sItem & "\GLO2GLF.flt" As sItem & "\GLO2GLF.txt"
End Function
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
Sub ImportGL()
Dim i As Long
Dim tempstr As String
Dim Fieldinfo As String
'Dim sItem As String
'Determine if worksheet GL already exists.
If WorksheetExists("GL") Then
MsgBox "GL Worksheet already exists. Excel will be closing."
Application.Quit
End
End If
Open sItem & "\GL02GLF.txt" For Input As
#1
Sheets.Add
Sheets(ActiveSheet.Name).Name = "GL"
Cells(1, 1) = "ACCT1"
Cells(1, 2) = "ACCT2"
Cells(1, 3) = "ACCT3"
Cells(1, 4) = "PERIOD"
Cells(1, 5) = "SOURCE"
Cells(1, 6) = "JNRLSRCNO"
Cells(1, 7) = "RECORD"
Cells(1, 8) = "VENDOR"
Cells(1, 9) = "DESCRIPTION"
Cells(1, 10) = "VOUCHERNO"
Cells(1, 11) = "PO NO"
Cells(1, 12) = "AMOUNT"
Cells(1, 13) = "TRANS CODE"
Columns("A:K").NumberFormat = "@"
Columns("L").NumberFormat = "0.00"
Columns("M").NumberFormat = "@"
i = 2
Do Until (EOF(1) = True)
Input
#1 , tempstr ' Get more data
Cells(i, 1) = Mid(tempstr, 1, 4)
Cells(i, 2) = Mid(tempstr, 5, 3)
Cells(i, 3) = Mid(tempstr, 8, 2)
Cells(i, 4) = Mid(tempstr, 10, 2)
Cells(i, 5) = Mid(tempstr, 12, 2)
Cells(i, 6) = Mid(tempstr, 14, 3)
Cells(i, 7) = Mid(tempstr, 17, 4)
Cells(i, 8) = Mid(tempstr, 21, 25)
Cells(i, 10) = Mid(tempstr, 52, 6)
Cells(i, 11) = Mid(tempstr, 58, 10)
Cells(i, 12) = Mid(tempstr, 68, 13)
Cells(i, 13) = Mid(tempstr, 81, 2)
i = i + 1
Loop
Close 1
'ActiveSheet.Visible = xlSheetHidden
End Sub
Sub ImportCOA()
Dim i As Long
Dim tempstr As String
Dim Fieldinfo As String
'Dim sItem As String
'Determine if sheet COA already exists.
If WorksheetExists("COA") Then
MsgBox "Chart of Account Worksheet already exists. Excel will be closing."
Application.Quit
End
End If
Open sItem & "\GL01COA.txt" For Input As
#1
Sheets.Add
Sheets(ActiveSheet.Name).Name = "COA"
Cells(1, 1) = "DIV-NO"
Cells(1, 2) = "POOL-NO"
Cells(1, 3) = "ACCT-TYPE"
Cells(1, 4) = "REC TYPE"
Cells(1, 5) = "ACCT-1"
Cells(1, 6) = "ACCT-2"
Cells(1, 7) = "ACCT-3"
Cells(1, 8) = "FSGRP"
Cells(1, 9) = "FSLN"
Cells(1, 10) = "DIVNO"
Cells(1, 11) = "ACTIVEFL"
Cells(1, 12) = "ACCT-NAME"
Columns("A:L").NumberFormat = "@"
i = 2
Do Until (EOF(1) = True)
Input
#1 , tempstr ' Get more data
Cells(i, 1) = Mid(tempstr, 1, 2)
Cells(i, 2) = Mid(tempstr, 3, 1)
Cells(i, 3) = Mid(tempstr, 4, 1)
Cells(i, 4) = Mid(tempstr, 5, 1)
Cells(i, 5) = Mid(tempstr, 6, 4)
Cells(i, 6) = Mid(tempstr, 10, 3)
Cells(i, 7) = Mid(tempstr, 13, 2)
Cells(i, 8) = Mid(tempstr, 15, 2)
Cells(i, 9) = Mid(tempstr, 17, 2)
Cells(i, 10) = Mid(tempstr, 19, 2)
Cells(i, 11) = Mid(tempstr, 21, 1)
Cells(i, 12) = Mid(tempstr, 22, 25)
i = i + 1
Loop
Close 1
'ActiveSheet.Visible = xlSheetHidden
End Sub
Sub ImportLD()
Dim i As Long
Dim tempstr As String
Dim Fieldinfo As String
'Dim sItem As String
'Determine if sheet COA already exists.
If WorksheetExists("LD") Then
MsgBox "Labor Distribution Worksheet already exists. Excel will be closing."
Application.Quit
End
End If
Open sItem & "\LD01LDF.txt" For Input As
#1
Sheets.Add
Sheets(ActiveSheet.Name).Name = "LD"
Cells(1, 1) = "TIMESHEET DATE"
Cells(1, 2) = "EMPL-ID"
Cells(1, 3) = "PAYCHK-TYPE"
Cells(1, 4) = "TIMESHEET DATE 2"
Cells(1, 5) = "ENTRY SEQ"
Cells(1, 6) = "EMP-ID"
Cells(1, 7) = "TIMESHEET DATE 3"
Cells(1, 8) = "PAYCHK-TYPE 3"
Cells(1, 9) = "ENTRY SEQ 3"
Cells(1, 10) = "ACCT1"
Cells(1, 11) = "ACCT2"
Cells(1, 12) = "ACCT3"
Cells(1, 13) = "REF1"
Cells(1, 14) = "REF2"
Cells(1, 15) = "DEPT"
Cells(1, 16) = "JOB CAT"
Cells(1, 17) = "PAY TYPE ID"
Cells(1, 18) = "TRADE CODE"
Cells(1, 19) = "HRS"
Cells(1, 20) = "COSTS"
Cells(1, 21) = "PAY FREQ"
Cells(1, 22) = "COMPUTE MTHD"
Cells(1, 23) = "FICA"
Cells(1, 24) = "CORRECT DATE 8"
Cells(1, 25) = "INPUTTER"
Cells(1, 26) = "GL UPDATE REF"
Cells(1, 27) = "UPDATE FLAG"
Cells(1, 28) = "RATE USED"
Columns("A:Q").NumberFormat = "@"
Columns("R:S").NumberFormat = "0.00"
Columns("T:AA").NumberFormat = "@"
i = 2
Do Until (EOF(1) = True)
Input
#1 , tempstr ' Get more data
Cells(i, 1) = Mid(tempstr, 1, 8)
Cells(i, 2) = Mid(tempstr, 9, 9)
Cells(i, 3) = Mid(tempstr, 18, 1)
Cells(i, 4) = Mid(tempstr, 19, 8)
Cells(i, 5) = Mid(tempstr, 27, 3)
Cells(i, 6) = Mid(tempstr, 30, 9)
Cells(i, 7) = Mid(tempstr, 39, 8)
Cells(i, 8) = Mid(tempstr, 47, 1)
Cells(i, 9) = Mid(tempstr, 48, 3)
Cells(i, 10) = Mid(tempstr, 51, 4)
Cells(i, 11) = Mid(tempstr, 55, 3)
Cells(i, 12) = Mid(tempstr, 58, 2)
Cells(i, 13) = Mid(tempstr, 60, 15)
Cells(i, 14) = Mid(tempstr, 75, 25)
Cells(i, 15) = Mid(tempstr, 100, 2)
Cells(i, 16) = Mid(tempstr, 102, 2)
Cells(i, 17) = Mid(tempstr, 104, 3)
Cells(i, 18) = Mid(tempstr, 107, 3)
Cells(i, 19) = Mid(tempstr, 110, 8)
Cells(i, 20) = Mid(tempstr, 118, 12)
Cells(i, 21) = Mid(tempstr, 130, 1)
Cells(i, 22) = Mid(tempstr, 131, 1)
Cells(i, 23) = Mid(tempstr, 132, 1)
Cells(i, 24) = Mid(tempstr, 133, 8)
Cells(i, 25) = Mid(tempstr, 141, 6)
Cells(i, 26) = Mid(tempstr, 147, 2)
Cells(i, 27) = Mid(tempstr, 149, 1)
Cells(i, 28) = Mid(tempstr, 150, 1)
i = i + 1
Loop
Close 1
' ActiveSheet.Visible = xlSheetHidden
End Sub
Sub ImportPools()
Dim i As Long
Dim tempstr As String
Dim Fieldinfo As String
'Dim sItem As String
'Determine if sheet COA already exists.
If WorksheetExists("Pools") Then
MsgBox "Pools Worksheet already exists. Excel will be closing."
Application.Quit
End
End If
Open sItem & "\CT03CPF.txt" For Input As
#1
Sheets.Add
Sheets(ActiveSheet.Name).Name = "Pools"
Cells(1, 1) = "DIV-NUM"
Cells(1, 2) = "POOL_NUM"
Cells(1, 3) = "TIER"
Cells(1, 4) = "POOL_NAME"
Cells(1, 5) = "REC_VAR_ACCT"
Cells(1, 6) = "REC_VAR_SUB_ACCT"
Cells(1, 7) = "REV_VAR_ACCT"
Cells(1, 8) = "REV_VAR_SUB_ACCT"
Cells(1, 9) = "WIP_ALLOC_ACCT"
Cells(1, 10) = "WIP_ALLOC_SUB_ACCT"
Cells(1, 11) = "iv_ALLO_ACCT"
Cells(1, 12) = "IV_ALLOC_SUB_ACCT"
Cells(1, 13) = "POOL_ALLOC_ACCT"
Cells(1, 14) = "POOL_ALLOC_SUB_ACCT"
Cells(1, 15) = "CODE"
Cells(1, 16) = "PROV_RATE"
Cells(1, 17) = "CY_TARGET_RATE"
Cells(1, 18) = "NY_TARGET_RATE"
Cells(1, 19) = "ACTUAL RATE"
Cells(1, 20) = "TO_TIER_2"
Cells(1, 21) = "TO_TIER_3"
Cells(1, 22) = "BASE_MODIFIER"
Cells(1, 23) = "INCL_TIER_1"
Cells(1, 24) = "INCL_BY_TIER_2"
Cells(1, 25) = "POOL_NAME_2"
Cells(1, 26) = "INCL_TIER_1_BURDEN"
Cells(1, 27) = "COST_OF_MONEY_RATE"
Cells(1, 28) = "VALUE_ADDED_FLAG"
Cells(1, 29) = "SC_BURDEN_ACCT"
Cells(1, 30) = "SC_BURDEN_SUB_ACCT"
Cells(1, 31) = "J_ABOVE_42"
Cells(1, 32) = "WIP_REC_ACCT"
Cells(1, 33) = "WIP_REC_SUB_ACCT"
Cells(1, 34) = "WIP_REV_ACCT"
Cells(1, 35) = "WIP_REV_SUB_ACCT"
Columns("A:O").NumberFormat = "@"
Columns("P:S").NumberFormat = "0.00"
Columns("T:Z").NumberFormat = "@"
Columns("AA").NumberFormat = "0.00"
Columns("AB:AI").NumberFormat = "@"
i = 2
Do Until (EOF(1) = True)
Input
#1 , tempstr ' Get more data
Cells(i, 1) = Mid(tempstr, 1, 2)
Cells(i, 2) = Mid(tempstr, 3, 1)
Cells(i, 3) = Mid(tempstr, 4, 1)
Cells(i, 4) = Mid(tempstr, 5, 20)
Cells(i, 5) = Mid(tempstr, 25, 4)
Cells(i, 6) = Mid(tempstr, 29, 3)
Cells(i, 7) = Mid(tempstr, 32, 4)
Cells(i, 8) = Mid(tempstr, 36, 3)
Cells(i, 9) = Mid(tempstr, 39, 4)
Cells(i, 10) = Mid(tempstr, 43, 3)
Cells(i, 11) = Mid(tempstr, 46, 4)
Cells(i, 12) = Mid(tempstr, 50, 3)
Cells(i, 13) = Mid(tempstr, 53, 4)
Cells(i, 14) = Mid(tempstr, 57, 3)
Cells(i, 15) = Mid(tempstr, 60, 1)
Cells(i, 16) = Mid(tempstr, 61, 8)
Cells(i, 17) = Mid(tempstr, 69, 8)
Cells(i, 18) = Mid(tempstr, 77, 8)
Cells(i, 19) = Mid(tempstr, 85, 8)
Cells(i, 20) = Mid(tempstr, 93, 1)
Cells(i, 21) = Mid(tempstr, 94, 1)
Cells(i, 22) = Mid(tempstr, 95, 1)
Cells(i, 23) = Mid(tempstr, 96, 1)
Cells(i, 24) = Mid(tempstr, 97, 1)
Cells(i, 25) = Mid(tempstr, 98, 7)
Cells(i, 26) = Mid(tempstr, 105, 1)
Cells(i, 27) = Mid(tempstr, 106, 8)
Cells(i, 28) = Mid(tempstr, 114, 1)
Cells(i, 29) = Mid(tempstr, 115, 4)
Cells(i, 30) = Mid(tempstr, 119, 4)
Cells(i, 31) = Mid(tempstr, 122, 1)
Cells(i, 32) = Mid(tempstr, 123, 4)
Cells(i, 33) = Mid(tempstr, 127, 3)
Cells(i, 34) = Mid(tempstr, 130, 4)
Cells(i, 35) = Mid(tempstr, 134, 3)
i = i + 1
Loop
Close 1
' ActiveSheet.Visible = xlSheetHidden
End Sub
Sub ImportSC()
Dim i As Long
Dim tempstr As String
Dim Fieldinfo As String
'Dim sItem As String
'Determine if sheet COA already exists.
If WorksheetExists("SC") Then
MsgBox "Service Center Worksheet already exists. Excel will be closing."
Application.Quit
End
End If
Open sItem & "\CT15SCM.txt" For Input As
#1
Sheets.Add
Sheets(ActiveSheet.Name).Name = "SC"
Cells(1, 1) = "DIV-NUM"
Cells(1, 2) = "POOL_NUM"
Cells(1, 3) = "CENTER_NAME"
Cells(1, 4) = "CENTER_ABBREV"
Cells(1, 5) = "ACCT1"
Cells(1, 6) = "ACCT2"
Cells(1, 7) = "ACCT3"
Cells(1, 8) = "DEPT_CODE_SUFFIX"
Cells(1, 9) = "DEPT_CODE_TRANS_CODE"
Cells(1, 10) = "STANDARD"
Cells(1, 11) = "YTD OR CURR"
Cells(1, 12) = "STD_COST_PRICE"
Cells(1, 13) = "POSTING_METHOD"
Cells(1, 14) = "BURDEN_ACCT1"
Cells(1, 15) = "BURDEN_ACCT2"
Cells(1, 16) = "BURDEN_POOL"
Columns("A:F").NumberFormat = "@"
Columns("G:H").NumberFormat = "0.00"
Columns("I:K").NumberFormat = "@"
Columns("L").NumberFormat = "0.00"
Columns("M:O").NumberFormat = "@"
Columns("P").NumberFormat = "0.00"
i = 2
Do Until (EOF(1) = True)
Input
#1 , tempstr ' Get more data
Cells(i, 1) = Mid(tempstr, 1, 2)
Cells(i, 2) = Mid(tempstr, 3, 1)
Cells(i, 3) = Mid(tempstr, 4, 25)
Cells(i, 4) = Mid(tempstr, 29, 10)
Cells(i, 5) = Mid(tempstr, 39, 4)
Cells(i, 6) = Mid(tempstr, 43, 3)
Cells(i, 7) = Mid(tempstr, 46, 2)
Cells(i, 8) = Mid(tempstr, 48, 2)
Cells(i, 9) = Mid(tempstr, 50, 2)
Cells(i, 10) = Mid(tempstr, 52, 1)
Cells(i, 11) = Mid(tempstr, 53, 1)
Cells(i, 12) = Mid(tempstr, 54, 3)
Cells(i, 13) = Mid(tempstr, 57, 1)
Cells(i, 14) = Mid(tempstr, 58, 4)
Cells(i, 15) = Mid(tempstr, 62, 3)
Cells(i, 16) = Mid(tempstr, 65, 1)
i = i + 1
Loop
Close 1
'ActiveSheet.Visible = xlSheetHidden
End Sub
Sub ChangeDates()
Dim OldDate As String
Dim NewDate As Date
Dim LastRow As Long
Dim sht As Sheets
Dim i As Long
Dim j As Long
Dim k As Long
'Sheets("LD").Application.Goto Reference:="R2C29"
LastRow = Sheets("LD").Cells(Rows.Count, "A").End(xlUp).Row
'MsgBox (LastRow)
' With Sheets("Sheet8")
Worksheets("LD").Activate
Cells(1, 29) = "TS DATE"
For i = 2 To LastRow
Range("AC" & i).Value = Mid(Range("A" & i).Value, 5, 2) & "/" & Right(Range("A" & i).Value, 2) & "/" & Left(Range("A" & i).Value, 4)
' Range("AD" & 1).Value = Mid(Range("D" & i).Value, 5, 2) & "/" & Right(Range("D" & i).Value, 2) & "/" & Left(Range("D" & i).Value, 4)
Next i
Columns("AC").Cut Destination:=Range("A1")
' End With
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Cells(1, 30) = "TS DATE1"
For j = 2 To LastRow
Range("AD" & j).Value = Mid(Range("D" & j).Value, 5, 2) & "/" & Right(Range("D" & j).Value, 2) & "/" & Left(Range("D" & j).Value, 4)
Next j
Columns("AD").Cut Destination:=Range("D1")
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Cells(1, 31) = "TS DATE2"
For k = 2 To LastRow
Range("AE" & k).Value = Mid(Range("G" & k).Value, 5, 2) & "/" & Right(Range("G" & k).Value, 2) & "/" & Left(Range("G" & k).Value, 4)
Next k
Columns("AE").Cut Destination:=Range("G1")
End Sub
Function FileExists(sFile As String)
sPath = sItem & ".flt"
FileExists = Dir(sPath) <> ""
End Function
