nelsonje
asked on
VB Find EXcel File and move to new file
I need to add a file move fuction to this vb code basically I need this vb to look in the
MyNewFile = "\\Tvhviruser.v09.med.va.g ov\tvhpubl ic\MCCR\59 6-Station Weekly Report\A-D\"
and move any excel files in this folder to another file ???
I also need to insert a formula into the exports on:
Set rs = db.OpenRecordset("A-E 1st Follow Up")
Set rs = db.OpenRecordset("A-E 2nd Follow Up")
Set rs = db.OpenRecordset("A-E 3rd Follow Up")
I need Column H to =IF(L2="","",0-(TODAY()-L2 )) of the excel sheet I am exporting recordsets??
If anyone has any ideas please let me know, thanks
MyNewFile = "\\Tvhviruser.v09.med.va.g
and move any excel files in this folder to another file ???
I also need to insert a formula into the exports on:
Set rs = db.OpenRecordset("A-E 1st Follow Up")
Set rs = db.OpenRecordset("A-E 2nd Follow Up")
Set rs = db.OpenRecordset("A-E 3rd Follow Up")
I need Column H to =IF(L2="","",0-(TODAY()-L2
If anyone has any ideas please let me know, thanks
Public Function AE()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
Dim rs As Recordset
Dim db As Database
Set db = CurrentDb
Mydirectory = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\AR Weekly Report Database\596-Station Weekly Report Database\Weekly Report.xls"
MyNewFile = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\596-Station Weekly Report\A-D\"
NewFilename = "Weekly Report "
MyMonth = Format(Now, "mm")
MyDay = Format(Now, "dd")
MyYear = Format(Now, "yyyy")
MyTime = Format(Time, "hh.mm.ss")
FileFormat = ".xls"
Password = ""
WriteResPassword = ""
ReadOnlyRecommended = False
CreateBackup = False
MyFileName = MyNewFile + NewFilename + MyMonth + MyDay + MyYear + MyTime + FileFormat
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(Mydirectory)
Do Until wb.Worksheets.Count = 13
wb.Worksheets.Add
Loop
Set rs = db.OpenRecordset("A-E 0-30 Days")
wb.Worksheets(1).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 31-60 Days")
wb.Worksheets(2).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 61-90 Days")
wb.Worksheets(3).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 91-120 Days")
wb.Worksheets(4).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 121-180 Days")
wb.Worksheets(5).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 181-365 Days")
wb.Worksheets(6).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E Over 365 Days")
wb.Worksheets(7).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E Payment&Resid Balance")
wb.Worksheets(9).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E Master")
wb.Worksheets(10).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 1st Follow Up")
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 2nd Follow Up")
wb.Worksheets(12).Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rs = db.OpenRecordset("A-E 3rd Follow Up")
wb.Worksheets(13).Range("A2").CopyFromRecordset rs
wb.Worksheets(8).Columns("E").Style = "Percent"
wb.Worksheets(8).Columns("G").NumberFormat = "@"
Set rs = Nothing
Set rs = db.OpenRecordset("A-E EEOB COUNT")
wb.Worksheets(8).Range("H3").CopyFromRecordset rs
Set rs = Nothing
wb.SaveAs MyFileName
'Close Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
End Function
<<I need Column H to =IF(L2="","",0-(TODAY()-L2 )) of the excel sheet I am exporting recordsets??>>
Are you wanting to set the value of cell H2 to
=IF(L2="","",0-(TODAY()-L2 ))
or do you need to set the value for each cell in column H to
H2 =IF(L2="","",0-(TODAY()-L2 ))
H3 =IF(L3="","",0-(TODAY()-L3 ))
H4 =IF(L4="","",0-(TODAY()-L4 ))
etc.
????
OM Gang
Are you wanting to set the value of cell H2 to
=IF(L2="","",0-(TODAY()-L2
or do you need to set the value for each cell in column H to
H2 =IF(L2="","",0-(TODAY()-L2
H3 =IF(L3="","",0-(TODAY()-L3
H4 =IF(L4="","",0-(TODAY()-L4
etc.
????
OM Gang
ASKER
I need to set the Value of each cell in column H
Here's a way to populate column H with the desired formula. Set the max value for intRowCounter high enough for your needs.
OM Gang
OM Gang
'add to your declarations section
Dim intRowCounter As Integer
Dim strFormula As String, strCell As String
Set rs = db.OpenRecordset("A-E 1st Follow Up")
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
'add formula to column H
'adjust the row count as necessary
For intRowCounter = 2 To 100
strCell = "H" & intRowCounter
strFormula = "=IF(L" & intRowCounter & "=" & Chr(34) & Chr(34) & "," _
& Chr(34) & Chr(34) & ",0-(TODAY()-L" & intRowCounter & "))"
wb.Worksheets(4).Range(strCell) = strFormula
Next intRowCounter
Set rs = Nothing
ASKER
I tried to do this VB code but it does not work the why I would like, I would like this foluma to be activly counting in the form so everyday when I go into this excel workbook it updated with the date count, does that make sense?
You can tell excel to recalculate the formulas, there's command for it. In Excel right click on an empty area of the toolbars and select to show the VBA toolbar, then open up VBA editor (or maybe could also use the VSA editor that's also there, but haven't tried it) and press F2 to see the Object Browser at the VBA window. There you can select to search the Excel library for "calculate" or "recalculate", "refresh" etc. to find the method you want
ASKER
OMGANG, I get an error on the move file VB code
"ERROR"
USER-DEFINED TYPE NOT DEFINED??
Do you know why?
"ERROR"
USER-DEFINED TYPE NOT DEFINED??
Do you know why?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thanks
Public Function AE()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
Dim rs As Recordset
Dim db As Database
Dim blResult As Boolean
blResult = MoveFiles()
If blResult = False Then
'problem with moving the Excel files
'decide how you want to proceed
End If
Set db = CurrentDb
OM Gang
Open in new window