Question

我想打开一个Excel工作表并为其写入值。

因此我写了这个

Private Sub Test()

Dim xlApp As Object
Dim xlWorkBook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("C:\Users\Marc\Dropbox\PROJECTEN\Lopend\office_VA\macroStore.xlsx", True, False)
xlWorkBook.sheets(1).Range("A2").Select

Set xlApp = Nothing
Set xlWorkBook = Nothing


End Sub

这一切都有效。但问题是现在每次打开一个新的excel文件。我只想打开一个现有的。有关如何改变这一点的想法吗？

Answer 1

试试这个：

Sub Test()

Dim xlApp As Object
Dim xlWorkBook As Object
Dim path As String
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

path = "C:\Users\Marc\Dropbox\PROJECTEN\Lopend\office_VA\macroStore.xlsx"
If IsFileOpen(path) Then
    Set xlWorkBook = GetObject(path)
Else
    Set xlWorkBook = xlApp.Workbooks.Open(path)
End If

Set xlApp = Nothing
Set xlWorkBook = Nothing

End Sub

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

注意：功能取自Microsoft site

打开excel文件并将值写入

1 个答案: