Excel File Removal

[baycolor]

Hi,

I'm using a report generating program (Crystal Reports) to automatically generate and place on a network drive five Excel workbooks once per week. The reporting application has the ability to email the workbooks to recipients but the problem is it is not smart enough to not email out a workbook when the workbook is empty.

I'm thinking a two step process to get around this. First I'd write some kind of program that would remove all workbooks in the directory that are empty. Second I'd write a little dos batch program that would email the remaining files in the directory.

My issue is with the first part. Is there a way to write an Excel macro that could can be executed from the DOS command line or from Start | Run that can tell if a workbook is empty and delete it if it is. I'm thinking this macro would open the workbook - check the contents of cell A1 and if it's empty close the workbook and delete it. If cell A1 is not empty close the workbook and go to the next workbook.

Second thing I thought of was doing something in VBA but isn't VBA actually the Excel macro language (that shows my experience level)?

Lastly I heard is that I can probably do something in Perl (no experience there either).

Point of this is to automate the process completely so whatever macro is run has to be able to be executed via Windows Scheduler or executeve via our Crystal Reports scheduler (it has the ability to execute files outside of Crystal Reports).

Hoping I can do something with Excel.

Thanks in advance for any input.

 

[AnotherHiggins]

This can certainly be done via VBA. Quick question, though: Do all of these workbooks contain only one sheet? If not, will they always open to the correct sheet for testing to see if the workbook is empty?

Assuming you can just test the sheet that the workbook opens to, something like this should work:

Sub RemoveEmptyFiles()
Dim fs
Set fs = Application.FileSearch

With fs
    .LookIn = "C:\Your\File\Path" [green]'replace with your actual file path[/green]
    .Filename = "*.xls" [green]'this will look for all excel files[/green]
    .Execute

    For i = 1 To .FoundFiles.Count
        Workbooks.Open .FoundFiles(i)
            [green]'Rather than depend on the first cell being empty, 
            'this will verify that there is no data in the entire sheet[/green]
            If Application.WorksheetFunction.CountA(Cells) = 0 Then
                MsgBox .FoundFiles(i) & " is empty"
                ActiveWorkbook.Close
                Kill .FoundFiles(i)
            Else
                MsgBox .FoundFiles(i) & " is not empty"
                ActiveWorkbook.Close
            End If
    Next i
End With

End Sub

You can schedule a macro to run every day (or multiple times per day) if you want to, but that will require keeping open the workbook that contains the macro.

I've never played around with trying to run a macro from Start > Run or a command line. Perhaps someone else here can help with that part of your question.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[firefytr]

You can do this with VBScript as well. Here is what to do:

Open Notepad
Paste this code there..

Dim XL, OL, WB, Msg, WS
Dim blnWB, blnXL, blnOL, blnEmail
Dim i, arrNames(4), strWB, strPath
Dim objFSO
On Error Resume Next
blnXL = False
Set XL = GetObject(, "Excel.Application")
If XL Is Nothing Then
    blnXL = True
    Set XL = CreateObject("Excel.Application")
End If
blnOL = False
Set OL = GetObject(, "Outlook.Application")
If OL Is Nothing Then
    blnOL = True
    Set OL = CreateObject("Outlook.Application")
End If
arrNames(0) = "C:\Documents and Settings\Zackb\Desktop\Book10.xls"
arrNames(1) = "C:\Documents and Settings\Zackb\Desktop\Book11.xls"
arrNames(2) = "C:\Documents and Settings\Zackb\Desktop\Book2.xls"
arrNames(3) = "C:\Documents and Settings\Zackb\Desktop\Book13.xls"
arrNames(4) = "C:\Documents and Settings\Zackb\Desktop\Book14.xls"
XL.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = LBound(arrNames) To UBound(arrNames)
    strPath = arrNames(i)
    If objFSO.FileExists(strPath) Then
        strWB = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
        blnWB = Empty
        blnWB = CBool(Len(XL.Workbooks(strWB).Name))
        If blnWB <> True Or IsEmpty(blnWB) Then
            Set WB = XL.Workbooks.Open(strPath)
        Else
            Set WB = XL.Workbooks(strWB)
        End If
        blnEmail = False
        For Each WS In WB.Worksheets
            If XL.WorksheetFunction.CountA(WS.Cells) <> 0 Then
                blnEmail = True
                Exit For
            End If
        Next
        If IsEmpty(blnWB) Then
            WB.Close False
        End If
        If blnEmail = True Then
            Set Msg = OL.createitem(0)
            Msg.To = "zackb@portofmorrow.com"
            Msg.Subject = "Subject here"
            Msg.Body = "Body here"
            Msg.Attachments.Add arrNames(i)
            Msg.send '.display '*
        Else
            Kill strPath
        End If
    End If
SkipWb:        '55
Next
XL.ScreenUpdating = True
'## Quitting outlook will not send messages first and
'   it will ask if you want to save any created.
If blnOL = True Then
    OL.Quit
End If
If blnXL = True Then
    XL.Quit
End If

Save the file as YourFileName.VBS (the extension is very important) wherever you want. You can run this file without opening Excel or Outlook to perform the process you desire.

* You may need Outlook Redemption for this. I have not tested without it.

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[firefytr]

Also, change the size of the array (set at 4 - look at line 3 of the code - arrays are set from 0, so 4 is an array of 5 elements) with the corresponding full paths to the files. This will check if the file exists, if it's open, etc, etc. Change the email info as well.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci