Results 1 to 5 of 5
  1. #1
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Another Code help (Access2000)

    Hi,
    Try:
    Else
    strFileNamePart = InputBox("File " & strFileName & " already exists," _
    & Chr(10) & "Please enter another filename not including " _
    & Chr(34) & ".xls" & Chr(34) & ": ")
    if strFileNamePart = "" then exit sub
    strFileName = "S:SRI_WORK_AREADOCUME~1" _
    & strFileNamePart & ".xls"
    DoCmd.OutputTo acOutputQuery, "SFMTradeReport", acFormatXLS, strFileName, True
    MsgBox "Data has been exported successfully.", vbInformation, "Export Confirmation"
    End If

    You will need to add Dim strFilenamePart as String to the start of your code.

    Hope that helps.
    Regards,
    Rory

    Microsoft MVP - Excel

  2. #2
    4 Star Lounger
    Join Date
    Aug 2001
    Location
    London, UK
    Posts
    516
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Another Code help (Access2000)

    **edited by Rory to avoid horizontal scrolling**

    Hi guys
    See the bolded code that is where I need your help. I was wondering if someone would tell me how I could exit the code when the user clicks on cancel. At the moment if the user selects cancel then the code saves the output with a space as its name.
    <pre>Sub test()
    Dim strFileName As String, strMsg As String, vResult As Variant
    Dim rstRecipients As DAO.Recordset
    Dim strFund As String
    strFund = "Soros"
    'On Error GoTo ExportSFMReport_Err
    Dim rst As DAO.Recordset, db As DAO.Database
    'Turn System warnings off
    DoCmd.SetWarnings False
    'Delete contents of the table
    DoCmd.RunSQL _
    "DELETE [tblSFMReportSource].* FROM [tblSFMReportSource] WITH OWNERACCESS OPTION;", 0
    'Run Append query to add SFM records to the table
    DoCmd.OpenQuery "AppendToSFMReportSource", acNormal, acEdit
    'Turn System warnings on.
    DoCmd.SetWarnings True
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tblSFMReportSource")
    If rst.BOF And rst.EOF Then
    vResult = MsgBox("There are no records. Would you like to send a fax?", _
    vbQuestion + vbYesNo)
    If vResult = vbYes Then
    'set value to merge
    Set rstRecipients = db.OpenRecordset("Recipients", dbOpenDynaset)
    With rstRecipients
    .MoveFirst
    .FindFirst "[Fund] = '" & strFund & "'"
    .Edit
    !Merge = True
    .Update
    End With
    Set rst = Nothing
    Set db = Nothing
    'Open fax cover
    Set objWord = CreateObject("Word.Basic")
    objWord.AppShow
    'objWord.AppMaximize "", 1 (optional)
    objWord.FileOpen "S:SRI_WO~1TRADEA~1Fax.doc"
    Exit Sub
    Else
    Exit Sub
    End If
    Else
    'Export records to spreadsheet and open it
    strFileName = "S:SRI_WORK_AREADOCUME~1" & "BCP" & Format(Now, "DDMMYY") & ".xls"
    vResult = Dir(strFileName)
    If vResult <> "" Then
    vResult = MsgBox("File " & strFileName & _
    " already exists, Would you like to overwrite that file?", vbYesNo)
    If vResult = vbYes Then
    DoCmd.OutputTo acOutputQuery, "SFMTradeReport", _
    acFormatXLS, strFileName, True
    MsgBox "Data has been exported successfully.", vbInformation, _
    "Export Confirmation"
    Else
    strFileName = "S:SRI_WORK_AREADOCUME~1" _
    & InputBox("File " & strFileName & " already exists," _
    & Chr(10) & "Please enter another filename not including " _
    & Chr(34) & ".xls" & Chr(34) & ": ") & ".xls"
    DoCmd.OutputTo acOutputQuery, "SFMTradeReport", acFormatXLS, _
    strFileName, True
    MsgBox "Data has been exported successfully.", _
    vbInformation, "Export Confirmation"
    End If

    Else
    DoCmd.OutputTo acOutputQuery, "SFMTradeReport", acFormatXLS, strFileName, True
    MsgBox "Data has been exported successfully.", vbInformation, "Export Confirmation"
    End If
    'Delete contents of the table
    DoCmd.RunSQL _
    "DELETE [tblSFMReportSource].* FROM [tblSFMReportSource] WITH OWNERACCESS OPTION;", 0
    DoCmd.OpenQuery "UpdateRecipients(Merge)", acNormal, acEdit
    Set rst = Nothing
    Set db = Nothing
    AppActivate "Microsoft Excel"
    End If </pre>


  3. #3
    4 Star Lounger
    Join Date
    Aug 2001
    Location
    London, UK
    Posts
    516
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Another Code help (Access2000)

    Thanx alot Rory! Ur an <img src=/S/angel.gif border=0 alt=angel width=15 height=21>
    It works fine now.
    <img src=/S/bravo.gif border=0 alt=bravo width=16 height=30>

    One more question:
    When I run this code, it takes about a minute, is there anyway I could shorten this time?

    PLEASE <img src=/S/help.gif border=0 alt=help width=23 height=15>

    <img src=/S/bow.gif border=0 alt=bow width=15 height=15>

  4. #4
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Another Code help (Access2000)

    You don't have a minute spare?
    It may be down to your hardware (and/or network) or simple volumes of data. How long does the append query take if you run it from the db window?
    If I get a chance, I'll see if I can streamline the code but I can't see anything immediately obvious that would cause it to take an unnecessarily long time.
    Regards,
    Rory

    Microsoft MVP - Excel

  5. #5
    4 Star Lounger
    Join Date
    Aug 2001
    Location
    London, UK
    Posts
    516
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Another Code help (Access2000)

    I think its caused because I've got few queries nested to run the queries which are in the code but I have no other way that I know to do What I want to do. It takes about a minute or so to run the code.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •