CODEWITHSUNDEEP
excelvbams-access
Kevin
Kevin

Reputation: 1

File Is Open In Another Application

I have some code in MS Access VBA that will allow the user to select an excel file from a browse window and once the file is selected it imports data in a preformatted upload tab in the spreadsheet. It also copies that file into an attachments folder.

This works most of the time but it frequently will lock the spreadsheet that they select and you can only open it as read-only and it will not unlock. I thought by using the .quit and .close it would let the file go but it only seems to happen some of the time which is strange. Maybe there is a better way to do this where I don't have to open the spreadsheet? Any ideas?

Private Sub cmdUpload_Click()

Dim FileObject, vFSO as Object
Dim objExc As Excel.Application
Dim objWbk As Excel.Workbook
Dim vSelectedSheet, vDest As String
Dim vRQID As Long
Dim ary As Variant



vRQID = Me.requestID
vDest = "C:\APP\Imports\Adjustment\" & vRQID & "\"
Set vFSO = VBA.CreateObject("Scripting.FileSystemObject")
Set FileObject = Application.FileDialog(3)


    FileObject.AllowMultiSelect = False
    If FileObject.Show = -1 Then
        With FileObject
              For Each vrtSelectedItem In .SelectedItems
                   ary = Split(.SelectedItems(1), "\")
                   vFile = ary(UBound(ary))
                   CurrentDb.Execute "INSERT Into table_Attachment ([requestID],[FileName],[Path],[AddedBy]) VALUES (" & vRQID & ", '" & ary(UBound(ary)) & "','" & vDest & ary(UBound(ary)) & "', '" & initUserName & "');"
                   If Len(Dir(vDest, vbDirectory)) = 0 Then
                       MkDir vDest
                   End If
              Next
        End With
        Forms!form_Request_Adjustment!cmdAttach.Caption = " Attachments (" & DCount("[attachmentID]", "[table_Attachment]", "[requestID]=" & vRQID) & ")"
        
        
        Set objExc = New Excel.Application
        Set objWbk = objExc.Workbooks.Open(FileObject.SelectedItems.Item(1)) 'open workbook
        vSelectedSheet = objWbk.Sheets(1).Name 'Returns the name of the first tab in the file
        objWbk.Close
        objExc.Quit
        Set objWbk = Nothing
        Set objExc = Nothing

        If vSelectedSheet = "Upload" Then 'If the first tab is upload then proceed
          DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "QueryUpload", FileObject.SelectedItems.Item(1), 1, vSelectedSheet & "!B4:AK" 'import the Standard Adjustment Report
        Else
          MsgBox """Upload"" sheet must be first sheet in workbook for upload"
        End If
    End If

End Sub

Upvotes: 0

Views: 632

Answers (1)

June7
June7

Reputation: 21370

As noted in comments, the order of cleanup commands might make a difference.

objWbk.Close
Set objWbk = Nothing
objExc.Quit
Set objExc = Nothing

Only alternative I can find opens a connection to workbook and then a recordset of the workbook schema. If the sheetname exists it will be in the TABLE_NAME field.

Function firstSheetname(theFullName As String) As String
Dim cn As ADODB.Connection
Dim rsT As ADODB.Recordset
Dim sT As String
Set cn = New ADODB.Connection
cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & theFullName _
    & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"""
cn.Open
Set rsT = cn.OpenSchema(adSchemaTables)

'use Find method to determine if sheetname exists
rsT.Find "TABLE_NAME='Upload$'"
If Not rsT.EOF Then firstSheetname = rsT("TABLE_NAME")

'or loop recordset
Do While Not rsT.EOF
    sT = rsT.Fields("TABLE_NAME")
    If Right(sT, 1) = "$" Then
        firstSheetname = Left(sT, Len(sT) - 1)
        Exit Do
    End If
    rsT.MoveNext
Loop

rsT.Close
cn.Close
End Function

Upvotes: 2

Related Questions