打開一個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