Hello all,

I copied and modified the code below to extract data from a Excel
workbook we are using as a form to a target file that becomes a
worklist. People fill out the Excel workbook form and save the file
as a number. At the end of the week, I run the macro and it extracts
the data from all of the saved files into one sheet. The run time
error appears to occur at the first file that has a longer length.
For example:

123456.xls
123456.xls
123456789.xls (gets stuck here)

I've tried troubleshooting and researching the runtime error topics
without success. The only thing that has work is if I open the first
file with the longer length and save it with the same name, the macro
will run without problems.

Thanks in advance.

Berni


Dim wsd As Worksheet 'target file
Dim wbc As Workbook 'source file
Dim IRowDst As Long
Dim szFileCur As String
Dim szDir As String

Call Template ' opens the destination template

ChDir ("U:\Data\Patient Financial Services\CKHS\PTFINSVC\Patient
Refund Requests\")

Const cszDir As String = "U:\Data\Patient Financial Services\CKHS
\PTFINSVC\Patient Refund Requests\"

Set wsd = ActiveSheet
IRowDst = Cells(Rows.Count, "A").End(xlUp).Row + 1
szFileCur = Dir(cszDir & "*.xls")

Do While szFileCur < ""
Set wbc = Workbooks.Open(szFileCur)

Application.EnableEvents = False
'get data here
wsd.Cells(IRowDst, 1) = wbc.Worksheets(1).Range("IU5")
'Facility
wsd.Cells(IRowDst, 2) = wbc.Worksheets(1).Range("IU8")
'Account Type
wsd.Cells(IRowDst, 3) = wbc.Worksheets(1).Range("B10") 'DOS
wsd.Cells(IRowDst, 4) = wbc.Worksheets(1).Range("B12")
'Patient full name
wsd.Cells(IRowDst, 5) = wbc.Worksheets(1).Range("B15") 'Pat
No
wsd.Cells(IRowDst, 6) = wbc.Worksheets(1).Range("IU17")
'Payee First Name (no punc)
wsd.Cells(IRowDst, 7) = wbc.Worksheets(1).Range("IV17")
'Payee Last Name
wsd.Cells(IRowDst, 8) = wbc.Worksheets(1).Range("IU20") 'Pat
Addr1
wsd.Cells(IRowDst, 9) = wbc.Worksheets(1).Range("IU22") 'Pat
Addr2
wsd.Cells(IRowDst, 10) = wbc.Worksheets(1).Range("IU24") 'City/
State
wsd.Cells(IRowDst, 11) = wbc.Worksheets(1).Range("B26") 'Zip
Code
wsd.Cells(IRowDst, 12) = wbc.Worksheets(1).Range("IU30") 'Expln
Refund
wsd.Cells(IRowDst, 13) = wbc.Worksheets(1).Range("B32")
'Expln2
wsd.Cells(IRowDst, 14) = wbc.Worksheets(1).Range("B36")
'Refund Amt
wsd.Cells(IRowDst, 15) = wbc.Worksheets(1).Range("B40")
'Requestor
wsd.Cells(IRowDst, 16) = wbc.Worksheets(1).Range("F40") 'Date

wbc.Close False

szFileCur = Dir
IRowDst = IRowDst + 1
Loop
Application.EnableEvents = True
End Sub

Not got time to test but see if this approach helps you will note that I have
made a vain attempt to shorten the code.


Sub AAA()
Dim wsd As Worksheet 'target file
Dim wbc As Workbook 'source file
Dim IRowDst As Long
Dim szFileCur As String
Dim szDir As String
Dim myarray()
Dim na As Integer

Call Template ' opens the destination template

Const cszDir As String = "U:\Data\Patient Financial
Services\CKHS\PTFINSVC\Patient Refund Requests\"


myarray = Array("IU5", "IU8", "B10", "B12", "B15", _
"IU17", "IV17", "IU20", "IU22", "IU24", _
"B26", "IU30", "B32", "B36", "B40", "F40")


Set wsd = ActiveSheet

With wsd

IRowDst = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

End With

szFileCur = Dir(cszDir & "*.xls", vbNormal)

Application.EnableEvents = False

Do While szFileCur < ""

Set wbc = Workbooks.Open(cszDir & szFileCur, ReadOnly:=True)

For na = 1 To 16
'get data here

wsd.Cells(IRowDst, na) = _
wbc.Worksheets(1).Range(myarray(na - 1))

Next na

wbc.Close False

Set wbc = Nothing

szFileCur = Dir

IRowDst = IRowDst + 1

Loop

Application.EnableEvents = True

End Sub

--
jb


"Berni" wrote:

Hello all,

I copied and modified the code below to extract data from a Excel
workbook we are using as a form to a target file that becomes a
worklist. People fill out the Excel workbook form and save the file
as a number. At the end of the week, I run the macro and it extracts
the data from all of the saved files into one sheet. The run time
error appears to occur at the first file that has a longer length.
For example:

123456.xls
123456.xls
123456789.xls (gets stuck here)

I've tried troubleshooting and researching the runtime error topics
without success. The only thing that has work is if I open the first
file with the longer length and save it with the same name, the macro
will run without problems.

Thanks in advance.

Berni


Dim wsd As Worksheet 'target file
Dim wbc As Workbook 'source file
Dim IRowDst As Long
Dim szFileCur As String
Dim szDir As String

Call Template ' opens the destination template

ChDir ("U:\Data\Patient Financial Services\CKHS\PTFINSVC\Patient
Refund Requests\")

Const cszDir As String = "U:\Data\Patient Financial Services\CKHS
\PTFINSVC\Patient Refund Requests\"

Set wsd = ActiveSheet
IRowDst = Cells(Rows.Count, "A").End(xlUp).Row + 1
szFileCur = Dir(cszDir & "*.xls")

Do While szFileCur < ""
Set wbc = Workbooks.Open(szFileCur)

Application.EnableEvents = False
'get data here
wsd.Cells(IRowDst, 1) = wbc.Worksheets(1).Range("IU5")
'Facility
wsd.Cells(IRowDst, 2) = wbc.Worksheets(1).Range("IU8")
'Account Type
wsd.Cells(IRowDst, 3) = wbc.Worksheets(1).Range("B10") 'DOS
wsd.Cells(IRowDst, 4) = wbc.Worksheets(1).Range("B12")
'Patient full name
wsd.Cells(IRowDst, 5) = wbc.Worksheets(1).Range("B15") 'Pat
No
wsd.Cells(IRowDst, 6) = wbc.Worksheets(1).Range("IU17")
'Payee First Name (no punc)
wsd.Cells(IRowDst, 7) = wbc.Worksheets(1).Range("IV17")
'Payee Last Name
wsd.Cells(IRowDst, 8) = wbc.Worksheets(1).Range("IU20") 'Pat
Addr1
wsd.Cells(IRowDst, 9) = wbc.Worksheets(1).Range("IU22") 'Pat
Addr2
wsd.Cells(IRowDst, 10) = wbc.Worksheets(1).Range("IU24") 'City/
State
wsd.Cells(IRowDst, 11) = wbc.Worksheets(1).Range("B26") 'Zip
Code
wsd.Cells(IRowDst, 12) = wbc.Worksheets(1).Range("IU30") 'Expln
Refund
wsd.Cells(IRowDst, 13) = wbc.Worksheets(1).Range("B32")
'Expln2
wsd.Cells(IRowDst, 14) = wbc.Worksheets(1).Range("B36")
'Refund Amt
wsd.Cells(IRowDst, 15) = wbc.Worksheets(1).Range("B40")
'Requestor
wsd.Cells(IRowDst, 16) = wbc.Worksheets(1).Range("F40") 'Date

wbc.Close False

szFileCur = Dir
IRowDst = IRowDst + 1
Loop
Application.EnableEvents = True
End Sub
.

On Oct 26, 11:50*am, john wrote:
Not gottimeto test but see if this approach helps you will note that I have
made a vain attempt to shorten the code.

Sub AAA()
* * Dim wsd As Worksheet * *'target file
* * Dim wbc As Workbook *'source file
* * Dim IRowDst As Long
* * Dim szFileCur As String
* * Dim szDir As String
* * Dim myarray()
* * Dim na As Integer

* * Call Template ' opens the destination template

* * Const cszDir As String = "U:\Data\Patient Financial
Services\CKHS\PTFINSVC\Patient Refund Requests\"

* * myarray = Array("IU5", "IU8", "B10", "B12", "B15", _
* * * * * * * * * * "IU17", "IV17", "IU20", "IU22", "IU24", _
* * * * * * * * * * "B26", "IU30", "B32", "B36", "B40", "F40")

* * Set wsd = ActiveSheet

* * With wsd

* * * * IRowDst = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

* * End With

* * szFileCur = Dir(cszDir & "*.xls", vbNormal)

* * Application.EnableEvents = False

* * Do While szFileCur < ""

* * * * Set wbc = Workbooks.Open(cszDir & szFileCur, ReadOnly:=True)

* * * * *For na = 1 To 16
* * * * 'get data here

* * * * wsd.Cells(IRowDst, na) = _
* * * * wbc.Worksheets(1).Range(myarray(na - 1))

* * * * Next na

* * * * wbc.Close False

* * * * Set wbc = Nothing

* * * * szFileCur = Dir

* * * * IRowDst = IRowDst + 1

* * Loop

* * Application.EnableEvents = True

End Sub

--
jb



"Berni" wrote:
Hello all,

I copied and modified the code below to extract data from a Excel
workbook we are using as a form to a target file that becomes a
worklist. *People fill out the Excel workbook form and save the file
as a number. *At the end of the week, Irunthe macro and it extracts
the data from all of the saved files into one sheet. *Theruntime
errorappears to occur at the first file that has a longer length.
For example:

123456.xls
123456.xls
123456789.xls (gets stuck here)

I've tried troubleshooting and researching the runtimeerrortopics
without success. *The only thing that has work is if I open the first
file with the longer length and save it with the same name, the macro
willrunwithout problems.

Thanks in advance.

Berni

Dim wsd As Worksheet 'target file
Dim wbc As Workbook *'source file
Dim IRowDst As Long
Dim szFileCur As String
Dim szDir As String

Call Template ' opens the destination template

ChDir ("U:\Data\Patient Financial Services\CKHS\PTFINSVC\Patient
Refund Requests\")

Const cszDir As String = "U:\Data\Patient Financial Services\CKHS
\PTFINSVC\Patient Refund Requests\"

Set wsd = ActiveSheet
IRowDst = Cells(Rows.Count, "A").End(xlUp).Row + 1
szFileCur = Dir(cszDir & "*.xls")

Do While szFileCur < ""
Set wbc = Workbooks.Open(szFileCur)

Application.EnableEvents = False
* * 'get data here
* * wsd.Cells(IRowDst, 1) = wbc.Worksheets(1).Range("IU5")
'Facility
* * wsd.Cells(IRowDst, 2) = wbc.Worksheets(1).Range("IU8")
'Account Type
* * wsd.Cells(IRowDst, 3) = wbc.Worksheets(1).Range("B10") * * *'DOS
* * wsd.Cells(IRowDst, 4) = wbc.Worksheets(1).Range("B12")
'Patient full name
* * wsd.Cells(IRowDst, 5) = wbc.Worksheets(1).Range("B15") * * *'Pat
No
* * wsd.Cells(IRowDst, 6) = wbc.Worksheets(1).Range("IU17")
'Payee First Name (no punc)
* * wsd.Cells(IRowDst, 7) = wbc.Worksheets(1).Range("IV17")
'Payee Last Name
* * wsd.Cells(IRowDst, 8) = wbc.Worksheets(1).Range("IU20") * * *'Pat
Addr1
* * wsd.Cells(IRowDst, 9) = wbc.Worksheets(1).Range("IU22") * * *'Pat
Addr2
* * wsd.Cells(IRowDst, 10) = wbc.Worksheets(1).Range("IU24") * * 'City/
State
* * wsd.Cells(IRowDst, 11) = wbc.Worksheets(1).Range("B26") * * 'Zip
Code
* * wsd.Cells(IRowDst, 12) = wbc.Worksheets(1).Range("IU30") * *'Expln
Refund
* * wsd.Cells(IRowDst, 13) = wbc.Worksheets(1).Range("B32")
'Expln2
* * wsd.Cells(IRowDst, 14) = wbc.Worksheets(1).Range("B36")
'Refund Amt
* * wsd.Cells(IRowDst, 15) = wbc.Worksheets(1).Range("B40")
'Requestor
* * wsd.Cells(IRowDst, 16) = wbc.Worksheets(1).Range("F40") * * 'Date

* * wbc.Close False

* * szFileCur = Dir
* * IRowDst = IRowDst + 1
* * Loop
Application.EnableEvents = True
End Sub
.- Hide quoted text -

- Show quoted text -

Thanks John! Your code worked perfectly.