Full Version: Modify Code To Prompt For Dates And Copy .txt Files Together In VBA
UtterAccess Discussion Forums > Microsoft® Access > Access Built-in Functions
saseymour
OK, how would I modify the following code to prompt the user to input a start and end date, then copy all .txt files from a target location into one file?
urrently, I manually go to the shared drive location, select the files, copy them to my local drive, then run a cmd line of copy *.txt data.txt
Then I load this file into excel and start analyzing it. I'd like to automate this a bit.
Any suggestions?
CODE
Sub BackupFiles()
Dim strDirectory As String, strFilename As String, dteCreated As Date
strDirectory = "C:\Reporting"
strFilename = Dir(strDirectory & "\*.xls*", 31)
Do While strFilename <> ""
If Not (strFilename = ".." Or strFilename = ".") Then
dteCreated = dateCreated(strDirectory & "\" & strFilename)
Name strDirectory & "\" & strFilename As _
"C:\Reporting\Archive\" & _
Trim(Str(Year(dteCreated))) & "\" & MonthName(Month(dteCreated)) & _
"\" & strFilename
End If
strFilename = Dir() 'Added per dbGuy
Loop
End Sub
Function dateCreated(strFilename As String) As Date
    Dim oFS As Object
    'This creates an instance of the MS Scripting Runtime FileSystemObject class
    Set oFS = CreateObject("Scripting.FileSystemObject")
    dateCreated = oFS.GetFile(strFilename).dateCreated
    Set oFS = Nothing
End Function
doctor9
saseymour,
ince you're going to be combining several text files and then analyzing the combination, why not do this instead:
1. Set the current workbook/worksheet to be the place for the combined data
2. Open each text file in Excel, one at a time, and
3. Copy the contents of the text file into the current workbook/worksheet, adding more data to the bottom of the worksheet as you go
4. Close the text files as you go
Once this is done, you have the combination of all of the text files in one worksheet open in Excel, ready to be analyzed. The user can then save the file with whatever path/filename they wish.
CODE
Sub CombineDirOfTextFiles()
    Dim strDirectory As String, strFilename As String
    Dim wb As Workbook, ws As Worksheet
    
'   Put all of the textfile into the current workbook/worksheet
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    strDirectory = "C:\Reporting"
'   Speed up processing by hiding what we're doing
    Application.ScreenUpdating = False
        
'   Get the first filename
    strFilename = Dir(strDirectory & "\*.txt", 31)
        
'   Move the cursor to the column A cell after the last used row
    ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Select
        
    Do While strFilename <> ""
        If Not (strFilename = ".." Or strFilename = ".") Then
        
'           Open the next text file
'           (Use your macro recorder as you open one of the files manually to adjust
'            the syntax for this bit.)
            Workbooks.OpenText Filename:=strDirectory & strFilename _
                , Origin:=932, 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)), TrailingMinusNumbers:=True
                    
'           Copy the current text file's contents
            Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy
'           Close the current text file
            ActiveWindow.Close
'           Paste the just-closed file's contents
'           after the end of the worksheet's current contents
            ws.Paste
'           Move the cursor to the column A cell after the last used row
            ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Select
                    
        End If
            
        strFilename = Dir
    Loop
        
'   Cleanup
    Set ws = Nothing
    Set wb = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

I've put in a comment that indicates that the Workbooks.OpenText method that I've used is probably not exactly what you will be using, so I'd recommend using your Macro Recorder as you open one of your text files in Excel. That way you can handle stuff like "is the first row headings?" and "Should I just let Excel auto-detect the columns?" and such.
Also note that this method is intended for use in Excel, since Access isn't really involved in the process at all. If you feel the event must be triggered from Access, you should be able to adapt this easily.
Hope this helps,
Dennis
saseymour
Dennis, thanks so much for your response, sorry that it has taken me this long to see it, but so many other issues have cropped up!
o, I modified your code for my file structure, and I step through it in the debug area - but after a few files of data entry, a message window pops up saying that there is a large amount of information on the Clipboard, do you want to be able to paste this information into another program later.
If I hit "yes" it works for about another 15 files, then errors out. If I hit "No" then it immediately errors on the ws.Paste line, with "Paste of object'_worksheet" failed.
I'm thinking that is because I just told the clipboard to empty itself, which held the current file information to paste.
So, how do I get around this pesky clipboard situation? I'd like to have it off, or perhaps clear the clipboard after each file is loaded?
doctor9
saseymore,
ell, in my test files there was barely any data, so this sort of thing makes sense, since I'm guessing your actual files are HUGE. <
Let's try this first. Add:
CODE
Application.DisplayAlerts = False

right after the "Application.ScreenUpdating = False" bit, and then put a "True" version right after the "Application.ScreenUpdating = True" bit.
This should turn off the warnings about your clipboard, with any luck.
Hope this helps,
Dennis
saseymour
Dennis-
o, that didn't display the clipboard message anymore, but after about 30 days worth of data (5500 lines) it died, with the "Paste of object'_worksheet" failed.
Am I asking this to do too much data pulling? If so, perhaps I could structure the macro so that it asks for a date range, and then allows me to append the existing data with another date range when the macro is run again?
doctor9
saseymour,
noticed that you selected "Any Version" when you started this thread. Is it possible that your data files are too large for Excel 2003 (or earlier) to handle? I know that Excel 2010 can handle much more.
EDIT: If necessary, it is certainly possible to avoid using Copy/Paste entirely. We could loop through the rows of the just-opened text file and assign the values from the text file to the next available row in the current file. It might be slower, but there'd be no copy/paste involved. Instead it would be essentially:
Workbooks("Summary").Sheets("SummarySheet").Cells(1425,1) = Workbooks("Textfile").Sheets("Textfile").Cells(1,1)
Workbooks("Summary").Sheets("SummarySheet").Cells(1425,2) = Workbooks("Textfile").Sheets("Textfile").Cells(1,2)
etc.
Hope this helps,
Dennis
ipisors
is a classic symptom of using Selection, Select, Active and Activate in Excel VBA.
his should not be done. A UA wiki article is in the process of being written about it (so I can stop typing about it and just point to the link instead), but the gist of it is:
Depending on code involving things like Selecting, Activating, and referring to Active-anything is considered bad coding practice in excel VBA. Eventually it will fail (as you are seeing now) for reasons that may seem like a certain thing, then something else., then something else....You get the gist.
For example this line:
CODE
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy
  • the range of what worksheet?
  • the Selection...how do you know what is selected? We know what is often selected when we first open Excel, and so what hopefully will be selected next time we're doing something similar, but is 'often/hopefully' the standard to code for...
  • activecell.. how do you know what cell is active?
The speed at which the VBA runs does not necessarily match what VBA believes is active at the moment, etc. That's not even figuring in having other excel workbooks, sheets active, etc. The line of code referenced above is occasionally going to actually determine the selection that gets pasted a few lines later. Which will, obviously, cause an error, as you can't paste Nothing from the clipboard.
I would use FSO (as first posted) to actually write data from text file into Excel. But, if you are going to use this method, it should be re-written as below.
Note: there are some lines where I can't quite tell what the original intent is, like:
CODE
'           Copy the current text file's contents
            Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy

Whatever it's intended to select, the Range needs to be prefaced entirely ... and Selection replaced with the intended range address or range object.
Due to my uncertainty over the exact method where it seems that selections are incremented each loop, then the next selection depending on the previous selection, I'm not 100% sure of my final output here, but it makes the demonstration I think.
CODE
Sub CombineDirOfTextFiles()
Dim strDirectory As String, strFilename As String
    Dim wb As Workbook, ws As Worksheet, wbSource As Workbook, rngDest As Range
    
'   Put all of the textfile into the current workbook/worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    
    strDirectory = "C:\Reporting"
'Speed up processing by hiding what we're doing
    Application.ScreenUpdating = False
        
'   Get the first filename
    strFilename = Dir(strDirectory & "\*.txt", 31)
        
'   Move the cursor to the column A cell after the last used row
    Set rngDest = ws.Cells(ws.UsedRange.Rows.Count + 1, 1)
        
    Do While strFilename <> ""
        If Not (strFilename = ".." Or strFilename = ".") Then
        
'           Open the next text file
'           (Use your macro recorder as you open one of the files manually to adjust
'            the syntax for this bit.)
            Set wbSource = Workbooks.Open(strDirectory & strFilename)
                    
'           Copy the current text file's contents
            wbSource.Sheets(1).Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
'           Close the current text file
            wbSource.Close (False)
'           Paste the just-closed file's contents
'           after the end of the worksheet's current contents
            rngDest.Paste
'           Move the cursor to the column A cell after the last used row
            Set rngDest = ws.Cells(ws.UsedRange.Rows.Count + 1, 1)
                    
        End If
            
        strFilename = Dir
    Loop
        
'   Cleanup
    Set ws = Nothing
    Set wb = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Lastly, how I think I would personally do this, and even this may need more tweaking, as I didn't see any specs posted about how your text file are set up (columns, delimiters, etc. etc.):
CODE
Sub CombineDirOfTextFiles()
'untested aircode
Dim fso As Scripting.FileSystemObject
Dim fsofolder As Scripting.Folder
Dim fsofile As Scripting.File
Dim ts As Scripting.TextStream
Dim ws As Worksheet
Set fso = New Scripting.FileSystemObject
Set fsofolder = fso.GetFolder("c:\reporting")
Set ws = ThisWorkbook.Worksheets(1)
Dim lastrow As Long
Dim rngDest As Range
'   Speed up processing by hiding what we're doing
    Application.ScreenUpdating = False
        
For Each fsofile In fsofolder.Files
   If Right(fsofile.Name, 3) = "txt" Then
        Set ts = fso.OpenTextFile(fsofile.Path, ForReading, False)
        Do Until ts.AtEndOfStream = True
            lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            'or lastrow= ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
            Set rngDest = ws.Range("A" & lastrow).Offset(1, 0)
            rngDest.Value = ts.ReadLine
        Loop
    End If
Next fsofile
        
ts.Close
    
    Application.ScreenUpdating = True
    
End Sub

And I think the 'assigning values' method would be faster than copy/paste.
doctor9
Isaac makes a good point. While it worked for my test files, which were very small, I had no idea just how large the actual files would be, and the problem this would introduce.
ennis
saseymour
Thanks for the input. I tried both of the suggestions from Ipisors.
our first suggestion on changing the method of range/selection/activate/etc, ran into similar problems.

' Copy the current text file's contents
wbSource.Sheets(1).Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy <-- this reads in the contents of the text file
' Close the current text file
wbSource.Close (False) <-- this clears the worksheet - is it supposed to do that? are the text file contents copied onto the clipboard?
' Paste the just-closed file's contents
' after the end of the worksheet's current contents
rngDest.Paste <-- this errors out - object does not support this property or method
' Move the cursor to the column A cell after the last used row
Set rngDest = ws.Cells(ws.UsedRange.Rows.Count + 1, 1)
** so looking through the locals window, when it errors out, the rngDest array has a row value of 2. So, is the rngDest variable able to have the .Paste function attached to it?
Then, when I tried the second method, these lines give me a compile error, user defined type not defined. I'm using excel 2010, so I am not sure why these are considered user-defined and also not being recognized.
Dim fso As Scripting.FileSystemObject
Dim fsofolder As Scripting.Folder
Dim fsofile As Scripting.File
UPDATE: So, I looked and the VBA reference for Microsoft Scripting Language was not checked in the Tools section. I did that, and I've been working through the code that Ipisors suggested. It works great - I am now working on getting the format of the columns into place, and also looking into how I would resolve the following issue:
On occasion, the text file gets corrupted - when this happens, I've noticed that the text file size is larger than 200K. All normal files are 150K or less. I'm looking into what type of IF statement I could put in place that would screen the files so that only the ones smaller than 200K get processed, so that it doesn't screw up the macro with the corrupted files.
Thoughts?
Thanks!
ipisors
while developing, check out what methods Intellisense displays for fsofile object after you type fsofile. (fso file and a Dot)
saseymour
I'll check into that.
n the meantime, I put an IF statement in - If Filelen(fsofile) < 200000 which appears to be working.
ipisors
Didn't even think of that, sounds great. Glad you got it working.
doctor9
Isaac,
ust wanted to thank you for stepping in and helping with this thread. thumbup.gif" style="vertical-align:middle" emoid=":thumbup:" border="0" alt="thumbup.gif" />
My original idea was clearly a little to "quick-and-dirty" and not ready for any amount of heavy lifting.
Dennis
ipisors
My privilege - any time <
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.