IMPORT TEXT FILE WITH VB

[Kenny]

Below you will see the code I am having problems with. The macro 1st imports
a text file and then updates another workbook with it. I need to select it,
export it to excel and then update another workbook with it. The first
problem is with the code that imports it. Also when importing a text file
excel names the 1st sheet the name of the file you import I need this line of
code: Set shtUpdate = wbkUpdate.Sheets("mildata20080318") to reflect the name
of this sheet automatically. Third, when this macro is complete I need to set
focus on cell a1 of workbook tracker and of course close this newley imported
file. Can you please help me?


Sub UpdateFromFile()
Dim wbkUpdate As Workbook
Dim shtUpdate As Worksheet
Dim strFilename As String
Dim lAccntNmbr As String
Dim lCollB As Long
Dim lCollC As Long
Dim lCollD As Long
Dim lCollE As Long
Dim lRowUpd As Long
Dim lRowHis As Long
Dim blnUpdated As Boolean

Dim datUpdate As Date

datUpdate = Now

ChDrive "C:/users/kenny/documents"
ChDir "C:/users/kenny/documents"
strFilename = Application.GetOpenFilename("Text files(*.txt),*.txt", ,
"Select update file"), Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False,
Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2,
1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1),
Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14,
1), Array(15, 1), Array( _
16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1),
Array(21, 1), Array(22, 1), _
Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27,
1), Array(28, 1), Array( _
29, 1)), TrailingMinusNumbers:=True
If strFilename <> "" Then
ThisWorkbook.Sheets("Tracker").Select
Set wbkUpdate = Application.Workbooks.Add(strFilename)
Set shtUpdate = wbkUpdate.Sheets("mildata20080318")
lRowUpd = 2
Do
With shtUpdate
lAccntNmbr = .Cells(lRowUpd, 1).Value
lBank = .Cells(lRowUpd, 3).Value
Rng = .Range("D" & (lRowUpd) & ":AC" & (lRowUpd)).Copy
End With
blnUpdated = False
With ThisWorkbook.ActiveSheet
lRowHis = 1
Do
lRowHis = lRowHis + 1
Loop Until .Cells(lRowHis, 1).Value = lAccntNmbr _
Or IsEmpty(.Cells(lRowHis, 1))
..Cells(lRowHis, 1) = lAccntNmbr
..Cells(lRowHis, 2) = lBank
..Range("AA" & (lRowHis)).PasteSpecial Paste:=xlPasteValues
End With
lRowUpd = lRowUpd + 1
Loop Until IsEmpty(shtUpdate.Cells(lRowUpd, 1))
wbkUpdate.Close SaveChanges:=False
End If
End Sub

 

[Per Jessen]

Hi Kenny

Use backslash in the ChDir statement. I assume you want to set datUpdate =
current date.
The code is untestet, but it should do the things you needed to be chaged.

Sub UpdateFromFile()
Dim wbkUpdate As Workbook
Dim shtUpdate As Worksheet
Dim strFilename As String
Dim lAccntNmbr As String
Dim lCollB As Long
Dim lCollC As Long
Dim lCollD As Long
Dim lCollE As Long
Dim lRowUpd As Long
Dim lRowHis As Long
Dim blnUpdated As Boolean

Dim datUpdate As Date

datUpdate = Date

ChDrive "C"
ChDir "C:\users\kenny\documents"
strFilename = Application.GetOpenFilename("Text files(*.txt),*.txt", ,
"Select update file", Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False,
Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2,
1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1),
Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14,
1), Array(15, 1), Array( _
16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1),
Array(21, 1), Array(22, 1), _
Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27,
1), Array(28, 1), Array( _
29, 1)), TrailingMinusNumbers:=True)
If strFilename <> "" Then
ThisWorkbook.Sheets("Tracker").Select
Set wbkUpdate = Application.Workbooks.Add(strFilename)
Set shtUpdate = wbkUpdate.Sheets.Add
shtUpdate.Name = ("mildata20080318")
lRowUpd = 2
Do
With shtUpdate
lAccntNmbr = .Cells(lRowUpd, 1).Value
lBank = .Cells(lRowUpd, 3).Value
Rng = .Range("D" & (lRowUpd) & ":AC" & (lRowUpd)).Copy
End With
blnUpdated = False
With ThisWorkbook.ActiveSheet
lRowHis = 1
Do
lRowHis = lRowHis + 1
Loop Until .Cells(lRowHis, 1).Value = lAccntNmbr Or
IsEmpty(.Cells(lRowHis, 1))
.Cells(lRowHis, 1) = lAccntNmbr
.Cells(lRowHis, 2) = lBank
.Range("AA" & (lRowHis)).PasteSpecial Paste:=xlPasteValues
End With
lRowUpd = lRowUpd + 1
Loop Until IsEmpty(shtUpdate.Cells(lRowUpd, 1))
wbkUpdate.Close SaveChanges:=False
End If
Sheets("Tracker").Range("A1").Select
End Sub

Regards,

Per