We help IT Professionals succeed at work.
Get Started

VB6 - Prompt to save as with commonDialog1

Wilder1626
Wilder1626 asked
on
972 Views
Last Modified: 2014-05-04
Hi

While using the below code to create an excel extract, i would like to show a prompt to save the file as so that i can save it anywhere on my PC.

 Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
  Dim wkbOut As Object   'Excel.Workbook
  Dim wksOut As Object   'Excel.Worksheet
  Dim rngOut As Object   'Excel.Range
  Dim sngStart As Single    'forperformance measurement
  Dim start_time As Long
  Dim end_time As Long
  Dim total_time As Long

  'output to Excel workbook
  lblStatus.Caption = "Begin Excel Data Export"
  Set xlObj = CreateObject("Excel.Application")
  Set wkbOut = xlObj.Workbooks.Add
  Set wksOut = wkbOut.Worksheets("Sheet1")  'can skip this step
  Set rngOut = wksOut.Range("A1")           'by replacing with wkbOut.Worksheets("Sheet1").Range("A1")
  
  Me.MousePointer = vbHourglass
  Me.Enabled = False
  
  xlObj.ScreenUpdating = False
  xlObj.Calculation = -4135     '=xlCalculationManual


  'BulkLoad rngOut, sngData
  Clipboard.clear 'Clear the Clipboard
    With MSHFlexGrid_crow_fly_loads
        .Col = 0
        .Row = 0
        .ColSel = .Cols - 1
        .RowSel = .Rows - 1
        Clipboard.SetText .Clip
    End With
     With xlObj.ActiveWorkbook.ActiveSheet
        .Range("A1").Select
        .Range("A1:S1").Interior.Color = RGB(205, 197, 191)
        .Columns("A:S").NumberFormat = "@"
        .Paste
        .Columns("A:S").AutoFit
        .Range("C2").Select
        ActiveWindow.FreezePanes = True
    End With

  xlObj.Calculation = -4105     '=xlCalculationAutomatic
  xlObj.ScreenUpdating = True
  xlObj.Visible = True
  
  Set rngOut = Nothing
  Set wksOut = Nothing
  Set wkbOut = Nothing
  Set xlObj = Nothing
  
  lblStatus.Caption = "Finished Excel Data Export."

  Me.MousePointer = vbDefault
  Me.Enabled = True

Open in new window


I have found this below code, but just can seem to put it in so that it really save.

Can you please help me?

Thanks

Private Sub Command_Click()
On Error GoTo eh
    With CommonDialog1
        .CancelError = True
        .Filter = "Text files (*xls) |*.xls"
        .ShowSave
        Open CommonDialog1.FileName For Output As #1
        Print #1, xlObj
        Close #1
   
    End With
        Exit Sub
eh:
    If Err <> cdlCancel Then
        MsgBox "Error #" & Err.Number & " - " & Err.Description
    End If
End Sub

Open in new window

Comment
Watch Question
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 8 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE