首先要將“工程－引用”中的Mic… Excel…選中

Dim StrTg As String

Dim xlApp As Excel.Application

Private Sub Command1_Click()

Set xlApp = New Excel.Application

Set xlApp = CreateObject("Excel.Application")

On Error Resume Next

xlApp.Visible = False

Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")

"開啟存在資料的Excdl檔案

If IntHs(Text1.Text,"活動表名","列名") = 0 Then

MsgBox "沒找到符合的記錄！"

Else

MsgBox "找到符合的記錄！"

End If

"xlBook.Save

"xlApp.Save

ActiveWorkbook.Close

xlBook.Close (True)

xlApp.Quit

Set xlApp = Nothing

End Sub

Private Function IntHs(StrYssj As String, Optional Mh As Integer,x as string,y as string ) As Integer

Dim Czbj As Boolean

Dim StrT As String

Dim I As Integer

Mh = 0

I = 0

Czbj = False

Do While Czbj = False

I = I + 1

StrT = xlApp.Worksheets(x).Range(y).Cells(I, 1)

If xlApp.Worksheets(x).Range(y).Cells(I, 1) = StrYssj Then

IntHs = I

Czbj = True

ElseIf Trim(xlApp.Worksheets(x).Range(y).Cells(I, 1)) = "" Then

IntHs = 0

Czbj = True

Mh = I - 1

End If

Loop

End Function