msgbox before opening a excel sheet

B

benjamin.grimm

Registered User.
Local time
Today, 01:24
Joined
Sep 3, 2013
Messages
125
Hello

i have a query, which looks like that:

Query

ID Year SAP Geris
1 2008 20,00 € 5,00 €
1 2009 40,00 € 4,00 €
1 2010 60,00 € 6,00 €
2 2007 80,00 € 4,00 €
2 2008 100,00 € 8,00 €
2 2009 100,00 € 4,00 €
3 2008 1.000,00 € 1,00 €
3 2009 100,00 € 8,00 €
3 2010 2,00 € 9,00 €
4 2008 9,00 € 10,00€


So each combination has an ID. It´s called the SuWID.

I want to Transfer the data to a fixed Excel sheet. I wrote the following code

Dim xlApp As Object ' Excel.Application
Dim xlBook As Object ' Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Dim rst As DAO.Recordset
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Mappe1.xlsx")
Set xlSheet = xlBook.sheets("Tabelle1")
Set rst = CurrentDb.OpenRecordset("abfrage1")
xlSheet.Range("A1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

The only Thing what i still want to have is that, before it opens the Excel form, which works allready perfectly well, that a msgbox will Show up and ask me, which SuWID do you want to see in the Excel sheet.

It that possible?
 
Last edited:
I have to give it to you, you have a good idea here.. I was think a bit complicated by creating QueryDefs.. Totally forgot about the use of CopyFromRecordset method..
Code: 
Public Sub someMethod()
    Dim xlApp As Object            [COLOR=Green] ' Excel.Application[/COLOR]
    Dim xlBook As Object             [COLOR=Green]' Excel.Workbook[/COLOR]
    Dim xlSheet As Object             [COLOR=Green]' Excel.Worksheet[/COLOR]
    Dim rst As DAO.Recordset, [COLOR=Blue]SuWID As Long[/COLOR]
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Map pe1.xlsx")
    Set xlSheet = xlBook.sheets("Tabelle1")
    [COLOR=Blue]SuWID = InputBox("Please enter the SuWID that you wish to export","Export Value required", 1)
[/COLOR]
    Set rst = CurrentDb.OpenRecordset([COLOR=Blue]"SELECT theFieldsYouWantToExport FROM theTableName WHERE theIDfield = " & SuWID[/COLOR])
    xlSheet.Range("A1").CopyFromRecordset rst
    rst.Close
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub
I have highlighted the changes..
 
hey thanks for your advice.

I changed it, but now i get an error message.

I changed the fields you want to Export in SAP, Geris, Pauschale, SuWID and Jahr.

Cause in my table i have those fields. I want to Export them.

I canged the table Name in Abfrage.

The Name of the table is abfrage.

I Changed the IDfield in SuWID

The Name of the ID is SuWID.

What did i do wrong?

Thanks a lot

Here is my new code:

Dim xlApp As Object ' Excel.Application
Dim xlBook As Object ' Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Dim rst As DAO.Recordset, SuWID As Long

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Mappe1.xlsx")
Set xlSheet = xlBook.sheets("Tabelle1")
SuWID = InputBox("Which ID do you want to export?", "Export value required", 1)

Set rst = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " & SuWID)
xlSheet.Range("A1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
 
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object ' Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Dim rst As DAO.Recordset, SuWID As Long

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Mappe1.xlsx")
Set xlSheet = xlBook.sheets("Tabelle1")
SuWID = InputBox("Which ID do you want to export?", "Export value required", 1)

Set rst = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " & SuWID)
xlSheet.Range("A1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

The error is there where it is yellow.

And the code error is "424" or sometime "13"

Sorry the text message of the code error are all not in english. Is it enough to have the numbers?

greetz
 
Last edited:
Unfortunately it is not enough with just the numbers.. Could you translate them? To a certain level? Try adding a conditional check.. Debugging..
Code: 
Public Sub someMethod()
    Dim xlApp As Object             [COLOR=Green]' Excel.Application[/COLOR]
    Dim xlBook As Object            [COLOR=Green] ' Excel.Workbook[/COLOR]
    Dim xlSheet As Object            [COLOR=Green] ' Excel.Worksheet[/COLOR]
    Dim rst As DAO.Recordset, SuWID As Long[COLOR=Blue], tmpStr As String[/COLOR]

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Map pe1.xlsx")
    Set xlSheet = xlBook.sheets("Tabelle1")
    
    SuWID = InputBox("Which ID do you want to export?", "Export value required", 1)
    tmpStr = "SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " & SuWID & ";"
    [COLOR=Blue]MsgBox tmpStr[/COLOR]
    Set rst = CurrentDb.OpenRecordset(tmpStr)
    [COLOR=Red]If rst.RecordCount > 0 Then[/COLOR]
        xlSheet.Range("A1").CopyFromRecordset rst
    [COLOR=Red]Else
        MsgBox "No information to Export", vbInformation, "No data exported"
    End If[/COLOR]
    rst.Close
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub
PS: Please use Code Tags when posting VBA Code
 
Ok first of all thank you again.

The runtime error is translated like that an "object is neccessary" Number "424"


I attached the database on this comment.

greetz


Code: 
Private Sub Befehl0_Click()
 
 
 
 
     Dim xlApp As Object ' Excel.Application
     Dim xlBook As Object ' Excel.Workbook
     Dim xlSheet As Object ' Excel.Worksheet
     Dim rst As DAO.Recordset, SuWID As Long, tmpStr As String
 
 
     Set xlApp = CreateObject("Excel.Application")
     xlApp.Visible = True
     Set xlBook = xlApp.Workbooks.Open("C:\Users\GRIMBEN\Desktop\Mappe1.xlsx")
     Set xlSheet = xlBook.sheets("Tabelle1")
     SuWID = InputBox("Which ID do you want to export?", "Export value required", 1)
 
     Set rst = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " & SuWID)
 
 
 
     If rst.RecordCount > 0 Then
 
 
 
 [SIZE=4]    [COLOR=red]xlSheet.Range("A1").CopyFromRecordset rst (Here it debugs)[/COLOR][/SIZE]
 
     Else
 
        MsgBox "No information to export", vbInformation, "No data exported"
 
    End If
 
 
     rst.Close
     Set rst = Nothing
     Set xlSheet = Nothing
     Set xlBook = Nothing
     Set xlApp = Nothing
 
 
End Sub
 

Attachments

Okay try this..
Code: 
Private Sub Befehl0_Click()
    Dim xlApp As Object         [COLOR=Green]'Excel.Application[/COLOR]
    Dim xlBook As Object       [COLOR=Green] 'Excel.Workbook[/COLOR]
    Dim xlSheet As Object      [COLOR=Green] 'Excel.Worksheet[/COLOR]
    Dim rst As DAO.Recordset, SuWID As Long, tmpStr As String

    SuWID = InputBox("Which ID do you want to export?", "Export value required", 1)
    
    Set rst = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " & SuWID)
    
    If rst.RecordCount > 0 Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlBook = xlApp.Workbooks.Open("C:\Users\pef\Documents\DiallerAgent Invalids.xls")
        Set xlSheet = xlBook.Sheets("Sheet1")
        xlSheet.Range("A1").CopyFromRecordset rst
    Else
        MsgBox "No information to export", vbInformation, "No data exported"
    End If
    
    rst.Close
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub
 
Great, thank you so much.

It works like i thought. :):):):)


Is it a lot to change in the VBA to get my first solution.

That in each spread sheet is each ID.


So like in spread sheet 1 is ID 1.

In spread sheet 2 is ID 2.


But one question before. How Long does it take if i have like 400 contracts, to Transfer all that to the different spread sheets?

greetz
 
Is it a lot to change in the VBA to get my first solution.

That in each spread sheet is each ID.


So like in spread sheet 1 is ID 1.

In spread sheet 2 is ID 2.
Click to expand...

I cannot see this anywhere however you can address sheets by an index so you could use sheets(suwid)

Brian
 
and how do i do that?

sorry i am not a pro in VBA.

I just know Basics and i understand codes.
 
Okay this code should be good to go.. Although I have not tested it..
Code: 
Private Sub Befehl0_Click()
    Dim xlApp As Object        [COLOR=Green] 'Excel.Application[/COLOR]
    Dim xlBook As Object       [COLOR=Green] 'Excel.Workbook[/COLOR]
    Dim xlSheet As Object       [COLOR=Green]'Excel.Worksheet[/COLOR]
    Dim [COLOR=Blue][B]rstID[/B][/COLOR] As DAO.Recordset, tmpStr As String
    [COLOR=Black]Dim rstGr As DAO.Recordset, strSQL As String[/COLOR]
    
    strSQL = "SELECT SuWID FROM Abfrage GROUP BY SuWID;"
    Set rstID = CurrentDb.OpenRecordset(strSQL)
    If rstID.RecordCount > 0 Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlBook = xlApp.Workbooks.Open("N:\tmpOutQry.xlsx")
        Do While Not rstID.EOF
            Set xlSheet = xlBook.Sheets.Add
            Set rstGr = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr FROM Abfrage WHERE SuWID = " &[COLOR=Red][B] rstID.Fields("SuWID")[/B][/COLOR])
            xlSheet.Range("A1").CopyFromRecordset rstGr
            rstGr.Close
            rstID.MoveNext
        Loop
    Else
        MsgBox "No information to export", vbInformation, "No data exported"
    End If
    rstID.Close
    Set rstID = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

What I have done is created another recordset. The first recordset will be taking the SuWID, you see I have used GROUP BY this will eliminate duplicates. As we need only one of each. Then we use this as the WHERE for the criteria in the NEXT recordset where the actual export will take place..

If you have any doubts in the code, please post back I will try to explain. Hope this helps.
 
I must be missing something as I can't see where you are naming the sheets based on the suwid.

Brian
 
hey Paul eugin,

this code works. It is amazing. Thank you so much. You are very Kind and an access proffesional.

But there is still two question. Sorry

1. Is it also possible to name the Sheets based on the SuWID?

2. I´ve created a Special Excel sheet, i put it in the Appendix.

Is it possible to use this sheet as a "Standard sheet".

The transfer of the data from the Access, should always go to this sheet. It doesn´t matter how many SuWID the access database has.

Example: If i have 200 SuWID, i need 200 Sheets with this Special "Standard sheet".

Do you know what i mean?

Greetz benjamin
 

Attachments

I copied this from the web as it was easier than typing out my own explanation

Brian

2. VBA code to rename multiple worksheets by specific cell value in each worksheet of the active workbook

Using the following VBA code, it will rename all worksheets of current workbook by using the content of specific cell. For example, you can type the worksheet name in the A1 cell of the whole workbook, and then the worksheet will be renamed as the cell value A1.

Step 1: Please specify a cell to contain the worksheet name in each worksheet and type the worksheet name in it. In this example, I will type the worksheet name in cell A1 in every worksheet.

Step 2: Click Developer > Visual Basic, and click Insert > Module in the Microsoft Visual Basic Application Windows.

Step 3: Please copy and paste the following code into the Module.

Sub RenameTabs()
For i = 1 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("A1").Value
End If
Next
End Sub

Step 4: Click button to execute the code. It will rename all worksheets by using the content of A1.

Notes: 1. You can change the Range (“A1”) to any other cell which contains the worksheet name.

2. If the specific cell has no content, then the worksheet of the specific cell will not be renamed.
 
hey Brian,

this is not really what i am looking for.

I don´t want to name the worksheet, with a specific cell value.

The Name of the worksheet should be the SuWID and should be created by the Transport of the data from the Access.


The second Topic is, that i have a Standard sheet and allways the data from the Access should get transfered to this specific Standard sheet. I put the Standard sheet in the Appendix, so you can have a look.

Many thanks.

greetz benjamin
 
I'm about to leave and won't be back on till next week, doing this on an iPad over breakfast, but isn't the suwid in a cell?

You can name sheets as you add them but the forums have plenty of people complaining that it does not always work, it appears to be a timing issue as it works in debug mode, ie stepping through the code , of course it may work ok in later releases of Office.

Sorry I don't have the latest versions so cannot look at accdb.

Brian
 
Hello benjamin.grimm, sorry I was not online since yesterday evening. Looks like many things have been going on here..

Well as I mentioned I did not test the code, although I did try it a bit. Renaming the Sheets is not a huge problem, this is the only line of code you need..
Code: 
            [COLOR=Green][B]:[/B][/COLOR]
            Set xlSheet = xlBook.Sheets.Add
            [COLOR=Blue][B]xlSheet.Name = "SuWID - " & rstID.Fields("SuWID")[/B][/COLOR]
            Set rstGr = CurrentDb.OpenRecordset("SELECT SAP,[COLOR=Green] [B]...........[/B][/COLOR]
            [COLOR=Green][B]:[/B][/COLOR]
Thanks for jumping in Brian.. :)
 
ok thanks so much.

It works.


I am so sorry i have one question more, cause i think you are a Genius.


And you can solve every Problem.


I have a Standard Excel file
I put the Standard Excel file in the Appendix.

I want that the data gets transfered allways to the Special sheet (Tabelle1)

The informations from e.g. SuWID1 go to the Standard Excel sheet (tabelle1)

The Information from e.g. SuWID2 go the Standard Excel sheet, but then in tab 2. (In tab 2 is then also already the Standard Excel sheet)

The Information from e.g. SuWID3 go to the Standard Excel sheet, but then in tab 3. (In tab3 is then also already the Standard Excel sheet)

Do you know what i mean?

greetz Benjamin
 

Attachments

Not a
wink.gif
benjamin.grimm said:
cause i think you are a Genius.
And you can solve every Problem.
Click to expand...
You don't really make much sense to be honest..
benjamin.grimm said:
I want that the data gets transfered allways to the Special sheet (Tabelle1)

The informations from e.g. SuWID1 go to the Standard Excel sheet (tabelle1)

The Information from e.g. SuWID2 go the Standard Excel sheet, but then in tab 2. (In tab 2 is then also already the Standard Excel sheet)

The Information from e.g. SuWID3 go to the Standard Excel sheet, but then in tab 3. (In tab3 is then also already the Standard Excel sheet)
Click to expand...
You ahve to help me out here.. What are Tabs and what are Sheets? A WorkBook can have multiple Sheets, so what are tabs?
 
You must log in or register to reply here.

Similar threads

Gasman
Solved Open Excel workbook, but have WorkBook_Open code run
Replies
19
Views
736
Gasman
Gasman
zelarra821
Solved Export to Excel and leave the workbook open
Replies
5
Views
765
zelarra821
zelarra821
MattBaldry
Solved Export and Format Excel
Replies
7
Views
1,162
Gasman
Gasman
R
Updating Excel spreadsheet from within the Access
Replies
8
Views
1,622
CJ_London
C
M
Solved Access to Excel link
Replies
8
Views
1,138
bastanu
bastanu

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom