Which Export to Excel Process is best to copy data into an existing formatted spreadsheet? (1 Viewer)

[JMongi]

Sorry If I've been confusing...

1. The user will double click on a cell in a spreadsheet.
2. If the user is double clicking on an appropriate cell - a server location will be opened in file explorer
3. If the user is double clicking anywhere else - nothing happens

So, yes, I need to verify the location of a double-clicked cell and its contents. It needs to be in column A (there is data in columns A:N) and needs to be populated with a value.

 

[JMongi]

If it's easier, the acceptable range of clickable cells is continuous so it should be relatively simple to define this range if that makes comparison easier.

Here is a truncated code version for clarity

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Columns(1) = "A" Then
    'Code for server location open'
End If
End Sub

I limited the code to one comparison check first to get that working, then I'll work on the other one. Then combine them together.

 

[Minty]

For a range to check if a cell is double-clicked

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:A23")) Is Nothing Then
        'put your code here
    End If
End Sub

 

[JMongi]

For a range to check if a cell is double-clicked

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:A23")) Is Nothing Then
        'put your code here
    End If
End Sub

I've seen that general comparison in other web searches but didn't understand what it was doing. Care to walk me through?
I understand the basics that "Target" is my doubleclicked cell range and Range("A1:A23") is the defined range that target must fall within.
I don't understand what the "Not Intersect" and "Is Nothing" are doing.

 

[arnelgp]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Left(Target.Address, 3) = "$A$" Then
'Code for server location open'
End If
End Sub

 

[Isaac]

I've gotten a little bit lost on this thread, but just catching up now.

Keep it simple...to me it's more readable to eliminate invalid situations at the top of the code. Just my opinion.

The first thing I do in a Worksheet_Change/click/double click procedure is along the lines of:
(say I want them to be clicking in row 1, columns a-c):

if target.row<>1 then exit sub
if target.column>3 then exit sub

.... and usually something to call off all bets if multiple cells are being acted on at once, but probably not applicable to your double click event.

people sometimes down-talk the method of using Exit Sub / Exit Function early on in your code, but I do make use of it quite a bit.
it's gives a major boost to readability, and is far easier to read and understand than your brain and eyes jumping back and forth schizophrenically between matching brackets on conditional logic.

 

[JMongi]

@Isaac - Well, I'm not the code police!
General practice (as far as I understand it...goodness knows I'm not a coder) is that criteria should be passed before executing anything. Readability is a very underrated benefit to good code. I understand the reasoning behind the idea of limiting "Exit Sub" but won't be writing you any tickets today

I was being tripped up mainly by what target.column does or does not return and failing to use the RC method for identifying things in VBA. @Minty code works perfectly even if I don't understand the commands being used!

So the last thing to to do to put a bow on this is to incorporate a section that identifies the last row that is populated (as this will be dynamic) and use that to set a custom range to use as the check.

P.S. If anyone wants to help me understand what Minty's suggested comparison is actually doing, feel free!
Edit: NEVERMIND! I finally found the Intersect help file on Microsoft's site. MAN is their search terrible. I can search "Intersect VBA" in Microsoft and get a whole list of nothing useful. I put the same search in Google and it comes right up.
Edit #2: Well, I just discovered that the reason my Microsoft searching was so bad was because I had "Reference" selected (maybe the default?) in the Content Area search filter on the left. When I selected "All" then the proper VBA method popped up immediately. That would have saved me SO much time in the past trying to figure out VBA methods. Gah!

 

[JMongi]

Ok, here is the final code with the folder open code left out for clarity. I added a programmatic determination of the last cell in the column target range.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim TestRng As Range
Dim lrow As Long
'Determine last cell in column A
lrow = Cells(Rows.Count, 1).End(xlUp).Row
'Set the target range for testing
Set TestRng = Range("A2:A" & lrow)
'Test the double click
If Not Intersect(Target, TestRng) Is Nothing Then   'Test for Server Folder Open
    'Open Server Folder location code
End If
End Sub

 

[JMongi]

Here is the real final code with all sheet functionality included. Different doubleclick actions for leftmost column and topmost row including a sort via topmost header doubleclick. As far as I can tell, the code works without issue.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True

'Setup Test Criteria for Doublclick
Dim OpenTestRng As Range
Dim SortTestRng As Range
Dim SortRange As Range
Dim lrow As Long
Dim lcol As Long

'Determine last cell in column A and last cell in Row 1
lrow = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column

'Set the target range for testing using R1C1 and the sort range
Set OpenTestRng = Range(Cells(2, 1), Cells(lrow, 1))
Set SortTestRng = Range(Cells(1, 1), Cells(1, lcol))
Set SortRange = Range(Cells(1, 1), Cells(lrow, lcol))

'Test the double click for location
If Not Intersect(Target, OpenTestRng) Is Nothing Then   'Test for Server Folder Open
    Dim Shex As Object
    Dim Unit As String
    Dim UnitTrunc As String
    Dim ServerPath As String
    Dim tgtfile As String
    Dim tgtfile2 As String
    Set Shex = CreateObject("Shell.Application")
   
    'Set the unit number and the folder locations
    Unit = Target.Value
    UnitTrunc = Mid(Unit, 4)
    ServerPath = "**REDACTED**"
    tgtfile = ServerPath & Unit & "\"
    tgtfile2 = ServerPath & UnitTrunc & "\"
    Debug.Print tgtfile
    Debug.Print tgtfile2
 
    If Not Dir(tgtfile, vbDirectory) = vbNullString Then        'check if regular unit file exists
        Shex.Open (tgtfile)
    Else
        If Not Dir(tgtfile2, vbDirectory) = vbNullString Then   'Check if a unit file without year prefix exists
            Shex.Open (tgtfile2)
        Else
            MsgBox "The Unit File Does Not Exist"
        End If
    End If
ElseIf Not Intersect(Target, SortTestRng) Is Nothing Then      'test for sort via column header
    If Cells(2, Target.Column) > Cells(lrow, Target.Column) Then  'Test to determine previous sort order
        SortRange.Sort Key1:=Target, Order1:=xlAscending, Header:=xlYes
    Else
        SortRange.Sort Key1:=Target, Order1:=xlDescending, Header:=xlYes
    End If
End If
End Sub

 

[JMongi]

@Isaac, @Minty, @arnelgp and any other gurus....
Well, I'm working on part 2 which is generating the excel file from scratch out of Access. I think I've got it most of the way there...but...my spreadsheet transfer command fails with a run-time read only error. First things first. Here is the code:

Option Compare Database
Option Explicit

Private Sub ExcelExport()

Dim oXL As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim qryExport as String
Dim excelFileName as String
Dim excelFilePath as String
Dim CodeFileName as String
Dim CodeFilePath as String
Dim ShtName as String
Dim CurrentDate as String
Dim excelFile as String
Dim lrow as Long
Dim lcol as Long

'Project Specific Information
    CurrentDate = Format(Now(),"DD-MMM-YYYY")
    qryExport = "qryAvailability"
    excelFileName = "UnitAvailabiltyList"
    excelFilePath = "\\***\TEST FOLDER\"
    CodeFileName = "AvailabilityVB.bas"
    CodeFilePath = "\\***\TEST FOLDER\"
    ShtName = "UNIT AVAILABILITY LIST"
    excelFile = excelFilePath & excelFileName & " " & CurrentDate & ".xlsm"

'Transfer data from Access to Excel spreadsheet
    DoCmd.TransferSpreadsheet acExport, 10, qryExport, excelFile

'Other Code that is not relevant at the moment

End Sub

So I haven't even got to testing my format code or vb import code or anything...blech. Anywho...

I presume for the moment that there is some wrinkle using linked tables/queries. My query is linked from the BE to the FE. So, since this is being done via code, do I need to initialize something in order for Access to pull the data from the linked query into the FE for executing my data transfer?

 

[Minty]

Check the file isn't already open somewhere, in the code and ask the user to close it first if it is.

 

[JMongi]

Check the file isn't already open somewhere, in the code and ask the user to close it first if it is.

Which file might that be? The BE, the FE, the spreadsheet (shouldn't exist)?

 

[JMongi]

I closed completely out of Excel and Access. Checked my task manger for rogue processes. All clear.
Launch DB. Main form has a button i threw on it to run the export. Clicked it.

The full error is:
Run-time error '3027':
Cannot update. Database or object is read-only.

Debug highlights the DoCmd.TransferSpreadsheet line.

The query I am trying to export is a linked query from the backend.

 

[Isaac]

Can you paste , here, the exact text of the error message?
edit sorry, i saw you just did crossed w/mine

 

[Minty]

The query should be in the front end? If it's based on a linked table that is no problem at all.

I meant the destination spreadsheet Excel file, it cannot be open at the time of you trying to export into it.
Use these functions to make sure - put them in a standard Module modBasFunctions - they will be really useful if you don't already have them

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

    'Firstly check there is a file to check ;)
    If Not FileExists(fileName) Then
        IsFileOpen = False        'doesn't exist so therefore it can't be open
        Exit Function
    End If

    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

Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes    As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory)        'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    'If Dir() returns something, the file exists.
    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)

End Function

Function FolderExists(strPath As String) As Boolean

    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)


End Function

 

[Isaac]

I closed completely out of Excel and Access. Checked my task manger for rogue processes. All clear.
Launch DB. Main form has a button i threw on it to run the export. Clicked it.

The full error is:
Run-time error '3027':
Cannot update. Database or object is read-only.

Debug highlights the DoCmd.TransferSpreadsheet line.

The query I am trying to export is a linked query from the backend.

is the back end sharepoint?

 

[JMongi]

@Minty - I will check out your functions. Is the first function supposed to return a boolean as well? Also, I was mistaken. Query is in FE. Just tables in the BE.
@Isaac - I saw your other thread when researching this. No, the BE is on a typical server share.

I changed the target location of the new spreadsheet to be local just in case it was a weird permission issue. Didn't help.

 

[JMongi]

I meant the destination spreadsheet Excel file, it cannot be open at the time of you trying to export into it.

Just to be clear, this should be creating a brand new excel spreadsheet. According to MS, this will actually fail silently if there is an existing excel spreadsheet as it has no ability to overwrite the file.

 

[Isaac]

are you sure qryAvailability is a select query? what happens if you double click it in the object list?
what happens if you right click on that query in the access object list and try to export it to excel?

 

[JMongi]

qryAvailability IS a select query.
Manually exporting the results to an excel file worked just fine.

It is an .xlsx file not an .xlsm file. Would that make a difference?