Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / March 2008

Tip: Looking for answers? Try searching our database.

IMPORT TEXT FILE WITH VB

Thread view: 
Enable EMail Alerts  Start New Thread
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
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.