VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7755
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   12585
   LinkTopic       =   "Form1"
   ScaleHeight     =   7755
   ScaleWidth      =   12585
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox TxtArea 
      Height          =   1815
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   7
      Top             =   2760
      Width           =   10215
   End
   Begin VB.CommandButton CmdArea 
      Caption         =   "讀取區域"
      Height          =   495
      Left            =   10920
      TabIndex        =   6
      Top             =   1560
      Width           =   1335
   End
   Begin MSComDlg.CommonDialog ComDlg 
      Left            =   11760
      Top             =   6960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.htm|*.htm"
   End
   Begin VB.TextBox TxtCell 
      Height          =   855
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   5
      Top             =   6720
      Width           =   10215
   End
   Begin VB.TextBox TxtLine 
      Height          =   1935
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Top             =   4680
      Width           =   10215
   End
   Begin VB.CommandButton CmdReadCell 
      Caption         =   "讀取一格"
      Height          =   495
      Left            =   10920
      TabIndex        =   3
      Top             =   3000
      Width           =   1335
   End
   Begin VB.TextBox TxtFile 
      Height          =   2415
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   240
      Width           =   10215
   End
   Begin VB.CommandButton CmdReadLine 
      Caption         =   "讀取表格一行"
      Height          =   495
      Left            =   10920
      TabIndex        =   1
      Top             =   2280
      Width           =   1335
   End
   Begin VB.CommandButton CmdOpen 
      Caption         =   "讀取網頁"
      Height          =   495
      Left            =   10920
      TabIndex        =   0
      Top             =   840
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    Dim strArea As String   '區域塊
    Dim AreaPosS As Long    '區域起點
    Dim AreaPosE As Long    '區域終點
    Dim strcell As String   '單元格字串
    Dim CellPosS As Long    '單元格起點
    Dim CellPosE As Long    '單元格終點
    Dim PosS As Long        '起點
    Dim PosE As Long        '終點
    Dim strReplace As String    '替換字串
    Dim iCols As Long           '總列數
    Dim iFileFlag As Integer    '文件標志

Private Sub CmdArea_Click()
    i = 1
    AreaPosE = 1


    Do While InStr(AreaPosE, TxtFile.Text, ">參保人報銷地區：") <> 0
        AreaPosS = InStr(AreaPosE, TxtFile.Text, ">參保人報銷地區：")
        If InStr(AreaPosS, TxtFile.Text, "bgcolor='#dddddd'>") = 0 Then
            AreaPosE = InStr(AreaPosS, TxtFile.Text, "</table>")
        Else
            AreaPosE = InStr(AreaPosS, TxtFile.Text, "bgcolor='#dddddd'>")
        End If
        strArea = Mid(TxtFile.Text, AreaPosS, AreaPosE - AreaPosS + 5)
    
        TxtArea = TxtArea & vbCrLf & strArea
        i = i + 1
    Loop
End Sub

Private Sub CmdOpen_Click()
   ComDlg.ShowOpen
   
   Fname = ComDlg.FileName
   If Fname <> "" Then
     TxtFile.Text = ""
    Open Fname For Input As #1
    b = ""
    Do Until EOF(1)
        Line Input #1, NextLine
     b = b & NextLine & vbCrLf
    Loop
    Close #1
    TxtFile.Text = b
End If
   
End Sub

Private Sub CmdReadCell_Click()
     LinePosE = 1
    strReplace = Trim(TxtLine.Text)
    TxtCell = ""
   For iCols = 1 To 15
     
    LinePosS = InStr(LinePosE, strReplace, "<td>")
    LinePosE = InStr(LinePosS, strReplace, "</td>")
    strcell = Mid(strReplace, LinePosS, LinePosE - LinePosS + 5)
        Do While InStr(1, strcell, "<") <> 0
           strcell = RepHtmFlg(Trim(strcell))
        Loop
   TxtCell = TxtCell & vbTab & Trim(Replace(strcell, vbTab, ""))
  Next
  
End Sub



Private Sub CmdReadLine_Click()
    Dim strLine As String
    Dim LinePosS As Long
    Dim LinePosE As Long
    i = 1
    LinePosE = 1
    Do While InStr(LinePosE, strArea, "<td>" & i & "</td>") <> 0
        LinePosS = InStr(LinePosE, strArea, "<td>" & i & "</td>")
        LinePosE = InStr(LinePosS, strArea, "</tr>")
        strLine = Mid(strArea, LinePosS, LinePosE - LinePosS + 5)
    
        TxtLine = TxtLine & vbCrLf & strLine
        i = i + 1
     Loop
    
End Sub

Public Function RepHtmFlg(HtmLine As String) As String
  Dim iPosS As Integer
  Dim iPosE As Integer
  Dim strRep As String
  
    iPosS = InStr(1, HtmLine, "<")
    iPosE = InStr(iPosS, HtmLine, ">")
    strRep = Mid(HtmLine, iPosS, iPosE - iPosS + 1)
    
     RepHtmFlg = Replace(HtmLine, strRep, "")

End Function