home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4609 / vbisam / sam4expo.frm < prev    next >
Text File  |  1994-07-08  |  5KB  |  162 lines
  1. VERSION 2.00
  2. Begin Form frmExport 
  3.    Caption         =   "VB/ISAM Sample Program SAM4 -- Export to .CSV"
  4.    ClientHeight    =   975
  5.    ClientLeft      =   1155
  6.    ClientTop       =   2145
  7.    ClientWidth     =   6825
  8.    ControlBox      =   0   'False
  9.    Height          =   1380
  10.    Left            =   1095
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   975
  15.    ScaleWidth      =   6825
  16.    Top             =   1800
  17.    Width           =   6945
  18.    Begin SSPanel pnlStopButton 
  19.       BackColor       =   &H00C0C0C0&
  20.       BevelInner      =   1  'Inset
  21.       Font3D          =   0  'None
  22.       ForeColor       =   &H00FF0000&
  23.       Height          =   975
  24.       Left            =   5460
  25.       TabIndex        =   1
  26.       Top             =   0
  27.       Width           =   1365
  28.       Begin SSCommand cmdStop 
  29.          Caption         =   "Stop"
  30.          Font3D          =   0  'None
  31.          FontBold        =   0   'False
  32.          FontItalic      =   0   'False
  33.          FontName        =   "MS Sans Serif"
  34.          FontSize        =   8.25
  35.          FontStrikethru  =   0   'False
  36.          FontUnderline   =   0   'False
  37.          Height          =   795
  38.          Left            =   90
  39.          Outline         =   0   'False
  40.          Picture         =   SAM4EXPO.FRX:0000
  41.          TabIndex        =   2
  42.          Top             =   90
  43.          Width           =   1185
  44.       End
  45.    End
  46.    Begin SSPanel pnlGauge 
  47.       BackColor       =   &H00C0C0C0&
  48.       BevelInner      =   1  'Inset
  49.       FloodColor      =   &H00008000&
  50.       FloodType       =   1  'Left To Right
  51.       Font3D          =   0  'None
  52.       FontBold        =   -1  'True
  53.       FontItalic      =   0   'False
  54.       FontName        =   "MS Sans Serif"
  55.       FontSize        =   13.5
  56.       FontStrikethru  =   0   'False
  57.       FontUnderline   =   0   'False
  58.       ForeColor       =   &H00000000&
  59.       Height          =   975
  60.       Left            =   0
  61.       TabIndex        =   0
  62.       Top             =   0
  63.       Width           =   5445
  64.    End
  65. End
  66. Option Explicit
  67.  
  68. Dim StopFlag As Integer
  69.  
  70. Sub cmdStop_Click ()
  71.  
  72.     Close #ExportFileNum
  73.     Kill ExportFileName
  74.  
  75.     StopFlag = True 'Main loop in Form_Activate will see this after DoEvents
  76.  
  77. End Sub
  78.  
  79. Sub Form_Activate ()
  80.  
  81.     Dim TempString As String
  82.     Dim PKey As String
  83.     Dim CSVString As String
  84.     Dim LinesWritten As Long
  85.     Dim PercentExported As Integer
  86.  
  87.  
  88.     'Refresh RecordsInFile information (may have added/deleted records):
  89.     rc = VMXInfo(DatasetRefNum, DatasetInfo)
  90.     If rc <> VIS_OK Then
  91.         TellUser (INFO_ERROR)
  92.         ExitProgram 'Panic exit
  93.     End If
  94.  
  95.     rc = VmxBOF(DatasetRefNum, 0)
  96.     LinesWritten = 0
  97.     PercentExported = 0
  98.     StopFlag = False    'see cmdStop
  99.     rc = VmxGet(DatasetRefNum, 0, XNEXT, "", Throwaway, PKey, ExportRecBuffer)  '"prime" the loop
  100.                 'CSVString = CSVString & "," & Format$(TempCurrency, "Standard")
  101.     
  102.     Do While rc = VIS_OK
  103.  
  104.         CSVString = QuoteMaybe(PKey)
  105.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Description)
  106.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.ProductCategory)
  107.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.FileType)
  108.         CSVString = CSVString & "," & QuoteMaybe(Format$(ExportRecBuffer.BasePrice, "Standard"))
  109.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.PricingNotes)
  110.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.CatalogPage)
  111.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.CompanyName)
  112.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Phone)
  113.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Fax)
  114.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Comments)
  115.         CSVString = CSVString & CRLFDelim
  116.  
  117.         Put #ExportFileNum, , CSVString
  118.         LinesWritten = LinesWritten + 1
  119.  
  120.         PercentExported = Int((LinesWritten / DatasetInfo.RecordsInFile) * 100)
  121.         If (PercentExported - pnlGauge.FloodPercent) >= 5 Then  'Update the indicator every 5%
  122.             pnlGauge.FloodPercent = PercentExported
  123.             DoEvents    'Be nice to Windows (also listen for StopFlag)
  124.             If StopFlag = True Then
  125.                 TellUser (EXPORT_ABORTED)
  126.                 Me.Hide
  127.                 Exit Sub
  128.             End If
  129.         End If
  130.         
  131.         rc = VmxGet(DatasetRefNum, 0, XNEXT, "", Throwaway, PKey, ExportRecBuffer)
  132.  
  133.     Loop
  134.  
  135.     'Make sure we finished the loop because we got to the end:
  136.     If rc <> VIS_NOT_FOUND Then
  137.         MBType = MB_ICONEXCLAMATION
  138.         Msg = "VmxGet error: " & Chr$(34) & VmxReturnCode$(rc) & Chr$(34) & " ...after exporting" & Str$(LinesWritten) & " lines."
  139.         MsgBox Msg, MBType, MBTitle
  140.         Close #ExportFileNum
  141.     Else
  142.         Close #ExportFileNum
  143.         MBType = MB_ICONINFORMATION
  144.         Msg = "Export complete."
  145.         MsgBox Msg, MBType, MBTitle
  146.     End If
  147.  
  148.     Me.Hide
  149.     
  150. End Sub
  151.  
  152. Function QuoteMaybe (SourceString As String) As String
  153.  
  154.     If InStr(SourceString, ",") = 0 Then
  155.         QuoteMaybe = SourceString
  156.     Else
  157.         QuoteMaybe = Chr$(34) & SourceString & Chr$(34)   'double-quotes
  158.     End If
  159.     
  160. End Function
  161.  
  162.