PDA

View Full Version : Modify code to run on multiple files



swaggerbox
03-22-2011, 01:54 AM
I have a code created by Mark

http://www.vbaexpress.com/forum/showthread.php?t=31784



Option Explicit

Sub exa()
Dim _
strLine As String, _
strLineOut As String, _
i As Long

With CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\sample.txt")
strLine = .ReadAll
.Close
End With

With CreateObject("VBScript.RegExp")
.Global = False
.MultiLine = True
.Pattern = "(<date)(.+)(/>)"

If .Test(strLine) Then
strLine = .Execute(strLine)(0)
For i = 1 To Len(strLine)
If IsNumeric(Mid(strLine, i, 1)) Then
strLineOut = strLineOut & Mid(strLine, i, 1)
End If
Next
Range("A1").Value = CLng(strLineOut)
End If
End With
End Sub


How do I change this so that this would run on multiple text files? I really suck at VBA and I bravely attempted to modify the code but I am getting an error. "Run-time error 6: Overflow." on line "Cells(j, 4).Value = CLng(strLineOut)". Hovering it over strLineOut = "200906182010429". The correct value would have been "2010429" but it is including the previous value "20090618"

What am doin wrong? Please offer me some advice.


Sub LoopColumn()
Dim c As Range
Dim strLine As String
Dim strLineOut As String
Dim i As Long
Dim j As Long
j = 7
For Each c In Range("G7", Range("G" & Rows.Count).End(xlUp))

'Code here
With CreateObject("Scripting.FileSystemObject").OpenTextFile(c)
strLine = .ReadAll
.Close
End With

With CreateObject("VBScript.RegExp")
.Global = False
.MultiLine = True
.Pattern = "(<date)(.+)(/>)"

If .Test(strLine) Then
strLine = .Execute(strLine)(0)
For i = 1 To Len(strLine)
If IsNumeric(Mid(strLine, i, 1)) Then
strLineOut = strLineOut & Mid(strLine, i, 1)
End If
Next

Cells(j, 4).Value = CLng(strLineOut)

j = j + 1
End If
End With
'End of Code
Next c
End Sub

Bob Phillips
03-22-2011, 02:20 AM
Sub LoopColumn()
Dim c As Range
Dim strLine As String
Dim strLineOut As String
Dim i As Long
Dim j As Long
j = 7
For Each c In Range("G7", Range("G" & Rows.Count).End(xlUp))

'Code here
With CreateObject("Scripting.FileSystemObject").OpenTextFile(c)
strLine = .ReadAll
.Close
End With

strLineOut = ""

With CreateObject("VBScript.RegExp")
.Global = False
.MultiLine = True
.Pattern = "(<date)(.+)(/>)"

If .Test(strLine) Then
strLine = .Execute(strLine)(0)
For i = 1 To Len(strLine)
If IsNumeric(Mid(strLine, i, 1)) Then
strLineOut = strLineOut & Mid(strLine, i, 1)
End If
Next

Cells(j, 4).Value = CLng(strLineOut)

j = j + 1
End If
End With
'End of Code
Next c
End Sub

swaggerbox
03-22-2011, 02:30 AM
Amazing xld! You just added this line: strLineOut = "" and kaboom. problem solved. thanks a lot!

Bob Phillips
03-22-2011, 03:31 AM
You actually told me what the problem was, the solution was quite easy when you did the work :)