Solved

VB Find EXcel File and move to new file

Posted on 2008-10-16
9
496 Views
Last Modified: 2012-05-05
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.gov\tvhpublic\MCCR\596-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
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

Open in new window

0
Comment
Question by:nelsonje
  • 4
  • 4
9 Comments
 
LVL 28

Expert Comment

by:omgang
Comment Utility
Here's a function you can call from your existing function to move all the Excel files.  Call it like this

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

Public Function MoveFiles() As Boolean

On Error GoTo Err_MoveFiles
 

    Dim objFSO As New FileSystemObject

    Dim objFolder As Folder

    Dim objFile As File

    Dim strSrcFileDir As String

    Dim strDestFileDir As String

    

        'source directory we are going to look in to check for Excel files

    strSrcFileDir = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\596-Station Weekly Report\A-D\"

        'set your destination directory here

    strDestFileDir = "c:\temp2\"

    

    Set objFolder = objFSO.GetFolder(strSrcFileDir)

    For Each objFile In objFolder.Files

        If Right(objFile.name, 4) = ".xls" Then

            objFSO.MoveFile objFile.PATH, strDestFileDir & objFile.name

        End If

    Next

        'set function return successful

    MoveFiles = True    
 

Exit_MoveFiles:

    Set objFile = Nothing

    Set objFolder = Nothing

    Set objFSO = Nothing

    Exit Function

    

Err_MoveFiles:

    MsgBox Err.Number & ", " & Err.Description, , "Error"

        'set function return unsuccessful

    MoveFiles = False

    Resume Exit_MoveFiles

    

End Function

Open in new window

0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
<<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  
0
 

Author Comment

by:nelsonje
Comment Utility
I need to set the Value of each cell in column H
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
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
'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

Open in new window

0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:nelsonje
Comment Utility
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?
0
 

Expert Comment

by:birbilis
Comment Utility
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
0
 

Author Comment

by:nelsonje
Comment Utility
OMGANG, I get an error on the move file VB code

"ERROR"
USER-DEFINED TYPE NOT DEFINED??

Do you know why?
0
 
LVL 28

Accepted Solution

by:
omgang earned 500 total points
Comment Utility
Try setting a reference to
Microsoft Scripting Runtime

OM Gang
0
 

Author Closing Comment

by:nelsonje
Comment Utility
thanks
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now