Exporting filtered tables into dif excel worksheets

[boblarson]

First up -

This code

' this is here for debugging only.  comment it out for production so Excel doesn't show.
    objXL.Visible = True

is there just for while you get it all sorted out. Otherwise you won't be able to see anything of what is going on and right now that is important. When all is working then you comment out that line and it will remain hidden to everyone.

Before you run the code each time have you opened up your task manager to make sure that there are no instances of Excel.EXE running in the processes window? It is important until we get it all working that you maike sure there aren't any until we get this figured out.

So, find this line in the export function:

On Error GoTo err_handler


and comment it out by putting an apostrophe in front of it like this:

'On Error GoTo err_handler

Then when you get your error you can click the DEBUG button and it will take you to the part that is having the problem. Once you get there find out what the values are of the variables we are using in the OpenWorkbook part. If you hover your mouse over the variable name while in break mode like that, you can see what the value is. Report back as to what it is so I can have a better clue as to what is happening.

The next time it errors

 

[Arleta]

Well, here is the situation now. I run the code and it opens the xls file and only puts the header. Then it stops and I get a run time error 3021 No current record.
When I press debug it leads me to the module at

rst.MoveFirst line.

I've checked before running the code and excel was not active and all my tables have at a column named BRANCH and one named SEND (field values = SEND).

 

[boblarson]

When I press debug it leads me to the module at

rst.MoveFirst line.

That's interesting because I didn't have rst.MoveFirst in my code. Are you sure it didn't say rst.MoveNext?

Also, we need to troubleshoot the SQL string that is supposedly pulling the data for the branch out of the table. So the first thing to do for that is to go to this code:

       If Instr(1, tdf.Name, "SEND") > 0 Then
          strSQL = "SELECT *  FROM [" & tdf.Name & "] WHERE [" & strField & "] = " & rst!Branch
          SendTQ2ExcelSheets strSQL, Replace(tdf.Name, "_SEND", vbNullstring), "C:\SomeFolder\" & rst!Branch & ".xls"
       End If

And put in a

Debug.Print strSQL

just before the SendTQ2ExcelSheets line.

Then we can see what the strSQL says in the Immediate Window (copy and past the lines here.

 

[Arleta]

first sorry for this late response, but we had a electric power cut off due to bad weather I guess. Anyway.

The code in the module was a copy-paste so I'm sure it says movefirst. I changed it to movenext but things didn't change at all. Again se same error.

Then I changed the SQL lines as below, not sure if Debug.Prin strSQL is in the right place. I hope it is:
Next
If InStr(1, tdf.Name, "SEND") > 0 Then
strSQL = "SELECT * FROM [" & tdf.Name & "] WHERE [" & strField & "] = " & rst!Branch
Debug.Print strSQL
SendTQ2ExcelSheets, strSQL, Replace(tdf.Name, "_SEND", vbNullString), "C:\My Documents\desktop\FRAUD\ACCESS DAILY AUDIT\AUDIT PROJECT\" & rst!Branch & ".xls"
End If
Next

Now There is a compile error that says: argument not optional. Something that I hadn't notice before it that automatically leaves a space after SendTQ2ExcelSheets , no matter if I put close the comma with the code it changes right after. Should it be this way?

 

[boblarson]

Sorry for my delay too - I had a dentist appointment.

The Move First IS supposed to be there. Sorry about that. I forgot that there is that which moves the recordset back to the beginning after using it for the column headers.

As for your argument not optional item you somehow put a comma (maybe I accidentally included it) just after SendTQ2ExcelSheets. Take that comma out.

Right now it shows:
SendTQ2ExcelSheets, strSQL, Replace(tdf.Name, "_SEND", vbNullString), "C:\My Documents\desktop\FRAUD\ACCESS DAILY AUDIT\AUDIT PROJECT\" & rst!Branch & ".xls"

And it should be
SendTQ2ExcelSheets strSQL, Replace(tdf.Name, "_SEND", vbNullString), "C:\My Documents\desktop\FRAUD\ACCESS DAILY AUDIT\AUDIT PROJECT\" & rst!Branch & ".xls"

As to the No Current Record it means that there isn't data in the recordset so there probably isn't data for that particular branch. So we should probably do a test of the recordset before doing the excel file and the headers and such by using

[COLOR=red]If rst.RecordCount > 0 Then[/COLOR]
 
Do Until rst.EOF
    For Each tdf In db.TableDefs
[COLOR=black]       For Each fld In tdf.Fields
          If Inst(1, fld.Name, "BRANCH") > 0 Then
             strField = fld.Name
             Exit For
          End If
       Next
[/COLOR]       If Instr(1, tdf.Name, "SEND") > 0 Then
          strSQL = "SELECT *  FROM [" & tdf.Name & "] WHERE [" & strField & "] = " & rst!Branch
          SendTQ2ExcelSheets strSQL, Replace(tdf.Name, "_SEND", vbNullstring), "C:\SomeFolder\" & rst!Branch & ".xls"
       End If
    Next
    rst.MoveNext
Loop

 
[COLOR=red]End If[/COLOR]

 

[Arleta]

Thanks for your reply! I hope u did well with the dentist.

Here is the situation now. I did a step further but i'm totally confused. So... I noticed that after running the code an xls file opened and only the header was written in this. And then again this run time error at the module in the line : rst.MoveFirst. So I had an idea to delete this table and see what will happen. After deleting this table things worked perfect but only for one branch. Trying to move next I got the following run time error 1004: Select method of Range class failed at the module line : xlWSh.Range("A1").Select

I have some comments here that may help you. My BRANCH field is not sorted therefore a branch may appear in various rows. Do you believe that this is something that may cause the code not working properly?

And something else. I noticed that for the table that the code worked properly was only one row record for this specific branch (2237). If same branch had more that one row records in the same table code could not put it together with the previous one (that is even if they were sorted).

I hope my comments are a bit helpful to you so to get a little further.

Thanks again!!

 

[boblarson]

Sorry for the delay - I was out sick yesterday and for much of the day after the dentist visit (the dental work turned out to be extremely painful after the anesthetic wore off).

Can you post the entire code you now have. I think we've gone through so much that I'd like to run through it again to make sure we have it in order (or as much as possible) before trying to fix other stuff.

 

[Arleta]

Hi again! Thanks for u still supporting me on this. The code now looks like this:

Private Sub xL_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strSQL As String
Dim strField As String
Dim fld As DAO.Field
 Dim objXL As Object

 
Set db = CurrentDb
 strSQL = "Select BRANCH FROM tinputBranchList " & _
            "ORDER BY BRANCH"
  
Set rst = db.OpenRecordset(strSQL)
 
If rst.RecordCount > 0 Then
 
Do Until rst.EOF
    For Each tdf In db.TableDefs
       For Each fld In tdf.Fields
          If InStr(1, fld.Name, "BRANCH") > 0 Then
             strField = fld.Name
             Exit For
          End If
       Next
       If InStr(1, tdf.Name, "SEND") > 0 Then
          strSQL = "SELECT *  FROM [" & tdf.Name & "] WHERE [" & strField & "] = " & rst!Branch
          SendTQ2ExcelSheets strSQL, Replace(tdf.Name, "_SEND", vbNullString), "D:\APROJECT\" & rst!Branch & ".xls"
       End If
    Next
    rst.MoveNext
Loop

 
End If
 
rst.Close
Set tdf = Nothing
Set rst = Nothing
Set db = Nothing

 

[boblarson]

Let's see if this works for us:

Change this:

[FONT=Courier New][COLOR=#0000bb]Set rst [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]db[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]OpenRecordset[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]strSQL[/COLOR][/FONT][COLOR=#007700][FONT=Courier New]) [/FONT]

[/COLOR]
to this:

[FONT=Courier New][COLOR=#0000bb]Set rst [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]db[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]OpenRecordset[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]strSQL, [COLOR=red]dbOpenDynaset[/COLOR][/COLOR][/FONT][COLOR=#007700][FONT=Courier New]) [/FONT][/COLOR]
[COLOR=#007700][FONT=Courier New]

[/FONT]

[/COLOR]

 

[Arleta]

Unfortunately nothing changed this time. Well, if u don't mind and have a little time I attach a small sample of my tables. Maybe this will help u find out if i'm doing something wrong.

 

[boblarson]

Guess what? It works now. I found the problem. It was that I forgot to include code to check to see if there were any records returned from the export query. So, now that I wrapped this around the majority of the function:

    Set rst = CurrentDb.OpenRecordset(strTQSQL)
    [COLOR=red]If rst.RecordCount > 0 Then[/COLOR]
        If objXL Is Nothing Then
            Set objXL = CreateObject("Excel.Application")
        End If
'...etc.

and then the End If here:

        xlWBk.Close
    [COLOR=red]End If[/COLOR]
    rst.Close
    Set rst = Nothing
ExitThis:
    Exit Function

Now, also - you do not need to have a reference set to Excel for this code to work. It uses late binding so you can use it without setting a reference and that way nobody gets a compile error if it is run on a lower version of Access than what you have.

And, unless you are using ADO somewhere you can remove the ADO reference as well.

 

[Arleta]

OMG!!!! Can't believe my eyes!! It is WORKING! YESSSSS!!!! I'm so so happy! Thank u so much!!!!

But now seems I have an issue with the xls file formatting. When I try to open a file I got the following message: This file you are trying to open, 2224.xls is in a different format that specified by the file extension.Verify that the file is not corrupted and is from a trusted source before opening this file. Do you want to open this file now?

If i press yes it opens the file and it looks ok!

This occurs even if I remove the excel reference or not.

 

[boblarson]

Hmm, that is a strange error. Not sure why that would be happening.

 

[boblarson]

OMG!!!! Can't believe my eyes!! It is WORKING!

And it only took us 10 days to get it done.

 

[Arleta]

And it only took us 10 days to get it done.

lol !!! Thanks for supporting me on this till the end! Now I have a hard work to do all the weekend to make this work with my real database.

As for the xls format it is also a very strange error. Never happend before and I've exported so many files with no problem. I'll try to run the code under my actual DB and see.

A billion thanks !!!!