打开一个excel文件并将值写入

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