Using Excel 2003, I'm writing what should be a quick application using VBA to open a series of Excel files and perform nearly 800,000 calculations (sad, but true).

Typically, I use the Workbooks.Open method, either preceeded by Application.GetOpenFilename so the user can select the file to open or without where the filename is generated programatically.

I'm running into Error 1004 (application generated, no details) with this simple statement:

Workbooks.Open Filename:=sStats, Origin:=xlWindows, AddToMru:=False

If I paste the contents of sStats into the Excel file open dialog, the workbook opens. All similarly coded statements in this application (and every other time I've used it on other projects) work. I had the same problem earlier when I tried breaking one of the file handlers out in it's own sub, but that must have been scope -related as it worked once I put the code directly in the calling routine.

I've also tried declaring a workbook object and using the alternative form of the open method:

Dim ws as workbook

set ws = Workbooks.Open Filename:=sStats

Same result if I omit the named argument.

Any ideas As far as I can tell, the syntax here is right on and it works repeatedly, then fails at the same location without any apparent reason.

I've pasted the entire code module (so far) below. The offending line is highlighted in yellow several pages down.

Thx,

Larry

'---------------------------------------------------------------------------
'MACROS FOR PROCESSING NIELSEN GALAXY FILES AND ESTIMATING STANDARD ERRORS
'1/6/2007 by Larry Goldstein
'---------------------------------------------------------------------------
Option Explicit

Public sSECalculator 'Nielsen NPM Standard Error Calculator
Public sStats As String 'Sample statistics filename & path
Public objSampleStats As Workbook 'Sample stats workbook object

Public Sub GetSECalculator()

Dim FileToOpen As Variant

Workbooks("SE Generator.xls").Activate

'Select Galaxy Explorer File(s)
FileToOpen = Application.GetOpenFilename("Standard Error Calculator (*.XLS),*.XLS", 1, "Open Nielsen Standard Error Calculator", MultiSelect:=False)
On Error Resume Next
If FileToOpen = False Then
If Err.Number = 0 Then
Exit Sub 'user clicked cancel
End If
End If
On Error GoTo 0

sSECalculator = FileToOpen
Set FileToOpen = Nothing

End Sub

Public Sub GetNielsenFiles()

Dim FileToOpen As Variant
Dim lNdx As Long
Dim lX As Long

Workbooks("SE Generator.xls").Activate

'Select Galaxy Explorer File(s)
FileToOpen = Application.GetOpenFilename("Microsoft Excel File (*.XLS),*.XLS", 1, "Open Galaxy Explorer Report", MultiSelect:=True)
On Error Resume Next
If FileToOpen = False Then
If Err.Number = 0 Then
Exit Sub 'user clicked cancel
End If
End If
On Error GoTo 0

Range(Cells(10, 1), Cells(500, 1)).Clear

lNdx = 10
For lX = LBound(FileToOpen) To UBound(FileToOpen)
Cells(lNdx, 1) = FileToOpen(lX)
lNdx = lNdx + 1
Next

Set FileToOpen = Nothing

End Sub

Public Sub ImportSampleStats()

Dim dbSampleDB As Database
Dim rstRecSet As Recordset

Workbooks("SE Generator.xls").Activate

'Open Access Database
FileToOpen = Application.GetOpenFilename("Microsoft Access Database (*.MDB),*.MDB", 1, "Open Sample Statistics Database", MultiSelect:=False)
On Error Resume Next
If FileToOpen = False Then
If Err.Number = 0 Then
Exit Sub 'user clicked cancel
End If
End If
On Error GoTo 0

Set dbSampleDB = DBEngine.OpenDatabase(FileToOpen)
Set FileToOpen = Nothing

'Select Sample Statistics File(s)
FileToOpen = Application.GetOpenFilename("Microsoft Excel File (*.XLS),*.XLS", 1, "Open Nielsen Sample Statistics", MultiSelect:=True)
On Error Resume Next
If FileToOpen = False Then
If Err.Number = 0 Then
Exit Sub 'user clicked cancel
End If
End If
On Error GoTo 0

lNdx = 10
For Each File In FileToOpen


Next

Set FileToOpen = Nothing
Set File = Nothing

End Sub

Public Sub SEGenerator()

Dim c As Object
Dim dtDate As Date 'report date
Dim dtTest As Date 'test date to assess which broadcast month a given date falls in
Dim lNdx As Long 'row index for Galaxy Reports
Dim lRow As Long 'row counter
Dim lWeekDay As Long 'day of week (Monday start)
Dim objSampleStats As Object 'sample statistics worksheet object
Dim objWorksheet As Object 'worksheet object
Dim sFile As String 'filename and path
Dim sParentPath As String 'path for the audience workbook
Dim sPeriod As String 'period reported (daily, week, month)
Dim sWorkbook As String 'Current Nielsen Galaxy workbook being processed

Dim wbStatistics As Workbook

Static stLastStats As String 'Last sample Stats file

Workbooks.Open Filename:=sSECalculator, ReadOnly:=True
Workbooks("SE Generator.xls").Activate
Cells(7, 1) = sSECalculator

lNdx = 10
Do
Workbooks("SE Generator.xls").Activate
sFile = Cells(lNdx, 1)

'Open selected Galaxy Report
Workbooks.Open Filename:=sFile, Origin:=xlWindows, AddToMru:=False

'Save to new file with .SE.XLS extension (so original is unchanged
sFile = Left(sFile, Len(sFile) - 3) & "SE.xls"

ActiveWorkbook.SaveAs Filename:=sFile, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

'Get renamed workbook name (w/out path) to retain as required to activate it later
sWorkbook = ActiveWorkbook.Name

'To speed up this process we will not let the user view the changes as they are made.
'# Application.ScreenUpdating = False

'------------------------------------------------------------------------------------------------
'Loop through all the worksheets
'------------------------------------------------------------------------------------------------
For Each objWorksheet In Worksheets
'--------------------------------------------------------------------------------------------
'Check to see if this worksheet is a compressable report
'--------------------------------------------------------------------------------------------
If Mid(UCase(objWorksheet.Name), 1, 10) = "TRACKING #" Then
'----------------------------------------------------------------------------------------
'Go into this worksheet and process it
'----------------------------------------------------------------------------------------
objWorksheet.Activate

'----------------------------------------------------------------------------------------
'Get Sample Statistics
'----------------------------------------------------------------------------------------
'Identify/Open Nielsen Sample Statistics File
sPeriod = UCase(Cells(2, 1))
If Left$(Trim$(sPeriod), 3) = "DAY" Or Left$(Trim$(sPeriod), 4) = "WEEK" Then
sStats = "Natl_wk_"
'Parse out Month/Day/Year, find Monday of the week
dtDate = CDate(Right(sPeriod, 10))
lWeekDay = Weekday(dtDate, vbMonday)
dtDate = dtDate - (lWeekDay - 1)
sStats = sStats & Format$(Month(dtDate), "00") & Format$(Day(dtDate), "00") & Right(CStr(Year(dtDate)), 2) & ".xls"
Else
sStats = "Natl__mo"
'Parse out Month/Day/Year
dtDate = CDate(Right(sPeriod, 10))

'If Sunday of week falls in the stated month,
'the broadcast month is the stated month; otherwise
'the broadcast month is the following month
lWeekDay = Weekday(dtDate, vbMonday)
dtDate = dtDate + 7 - lWeekDay
sStats = sStats & Format$(Month(dtDate), "00") & Right(CStr(Year(dtDate)), 2) & ".xls"
End If

'Open Sample Statistics File
If sStats <> stLastStats Then
If Len(stLastStats) > 0 Then
Workbooks(stLastStats).Close
End If
sParentPath = objWorksheet.Parent.Path
For lNdx = Len(sParentPath) To 1 Step -1
If InStr(lNdx, sParentPath, "\") <> 0 Then
sParentPath = Left(sParentPath, lNdx)
Exit For
End If
Next

'Save as static variable to avoid repeatedly opening the same file
stLastStats = sStats
sStats = sParentPath & sStats

This is where the application fails with no apparent cause. The file I am attempting to open does exist (Dir function returns the filename and Excel can open it manually).
Workbooks.Open Filename:=sStats, Origin:=xlWindows, AddToMru:=False

'Calculate % coverages for each cable network and add to Sample Statistics
'First check to assure this hasn't been done already (for updates/reprocessing, etc.)
Workbooks(stLastStats).Activate
Cells(4, 12) = "% 21+ U.S. Coverage"
With Worksheets(1).Range("D1:D500")
Set c = .Find("PERSONS 21+", LookIn:=xlValues)
If Not c Is Nothing Then
lRow = c.Row + 1
Do
If IsNumeric(Cells(lRow, 5)) Then
Cells(lRow, 12) = Cells(lRow, 5) / Cells(c.Row, 5) * 100
Else
Cells(lRow, 12) = 0
End If
lRow = lRow + 1
Loop While Cells(lRow, 4) = "PERSONS 21+"
End If
End With

End If

SECalc objWorksheet, stLastStats
End If
Next objWorksheet

'# Application.ScreenUpdating = True

Workbooks("SE Generator.xls").Activate
lNdx = lNdx + 1
Loop Until Len(Cells(lNdx, 1)) = 0

End Sub

'SECalc Sub
'Process Standard Errors for all rows in the current worksheet
Private Sub SECalc(objWorksheet As Worksheet, sStats As String)

On Error GoTo SECalcErr


Exit Sub

SECalcErr:
MsgBox "Error " & Err.Description & " in SECalc"
End Sub

'---------------------------------------------------------------------------
'END MACRO COLLECTION FOR PROCESSING NIELSEN GALAXY AND STANDARD ERRORS
'---------------------------------------------------------------------------

Hi all I only know a little about VB but have made a form on word that copys a word from the document saves itself to a folder prints a copy and then exits word. it all works fine except i cannot get it to paste the word from the document in the fileName when it saves. The script is below with red showing the problem. Any help on this would be much apreciated

Mark

Sub Process()
'
' Process jobsheet macro
' Macro recorded 09/01/2007 by Mark Smith
'
ActiveDocument.Shapes("Text Box 6").Select
Selection.WholeStory
Selection.Copy
ChangeFileOpenDirectory _
"E:\Global Internet Learning Ltd Files\Duplication Centre\Client Job Sheets\"
ActiveDocument.SaveAs FileName:= , FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close
Application.Quit
End Sub

Hi,

I'm from Brazil and this year I want to find a job in Canada. Preferably something with .NET.
Is anybody here from Canada I want to talk with somebody to know more about life in Canada, career and this stuffs...

My messenger address is:d_foliveira@hotmail.com .

Thanks a lot. I really appreaciate some help.

[]'s

Hi,

I am new to VBA. I am looking to make a query to MSSQL server for raw data, then I would apply format to the data.

How would I make a query

Is there any good tutorial sites on the web