MS Office Forum / Excel / Programming / March 2008
IMPORT TEXT FILE WITH VB
|
|
Thread rating:  |
Kenny - 22 Mar 2008 02:53 GMT 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 - 22 Mar 2008 11:41 GMT 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
> Below you will see the code I am having problems with. The macro 1st > imports [quoted text clipped - 75 lines] > End If > End Sub
|
|
|