UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
2 Pages V < 1 2  (Go to first unread post)
   Reply to this topicStart new topic
> Aggregating Data In Spreadsheets (simple Example), Access 2013    
 
   
RJD
post Jun 27 2018, 02:37 PM
Post#21


UtterAccess VIP
Posts: 8,943
Joined: 25-October 10
From: Gulf South USA


You are very welcome. We are all happy to assist.

Another thought: Since the totals for duration do not seem especially useful, you might consider a list of times instead, all on the single group row. This can be done with theDBguy's SimpleCSV function (included in the mod to your db attached). Or you might consider using the Average as well.

HTH
Joe
Attached File(s)
Attached File  AggregatingData_Rev1.zip ( 78.23K )Number of downloads: 6
 
Go to the top of the page
 
williamlove
post Jun 27 2018, 06:42 PM
Post#22



Posts: 134
Joined: 8-February 06



Its been amazing working with you as well. You inspired me to try it and you were right, it wasn't hard. I did it slightly different than you suggested. I had learned about FSO when I did something years ago with text files so I got to use my own code as sample code.

I put two questions in comments down near the end. Next to wkb.Close and appExcel.Quit. I was not sure if they were in the right place or actually needed. Cheers! cheers.gif

CODE
Private Sub btnGetDataFromExcel_Click()
'Set a Reference to the Microsoft Excel Object Library
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim sht As Excel.Worksheet
Dim intRow As Integer
Dim strSQL As String
Dim stFileName As String

Dim fso As New FileSystemObject 'Must set reference to Microsoft Scripting Runtime.
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String

strPath = "C:\Users\lovewilx\Desktop\Alarms\"
Set objFolder = fso.GetFolder(strPath)
'Check if the folder is empty or not
If objFolder.Files.Count = 0 Then
  MsgBox "No files were found...", vbExclamation
  Exit Sub
End If

intRow = 2          'Initiate Row Number
Set appExcel = New Excel.Application

CurrentDb.Execute "DELETE * FROM tblData", dbFailOnError

For Each objFile In objFolder.Files 'Loop thru Files
    stFileName = strPath + objFile.Name
    Set wkb = appExcel.Workbooks.Open(stFileName)
    For Each sht In wkb.Worksheets      'Loop thru Worksheets. If there's one called Top Alarms process it
        If sht.Name = "Top Alarms" Then
          With sht
            Do While .Cells(intRow, "A").Value <> ""       'as long as Data exists in Column 'A'
              strSQL = "INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration], [Project]) VALUES(" & .Cells(intRow, "A").Value & _
                       ", '" & .Cells(intRow, "B").Value & "'" & _
                       ", """ & .Cells(intRow, "C").Value & """" & _
                       ", '" & .Cells(intRow, "D").Value & "'" & _
                       ", '" & .Cells(intRow, "E").Value & "'" & _
                       "," & fConvertDuration(.Cells(intRow, "F").Value) & _
                       ", '" & .Cells(intRow, "G").Value & "'" & ")"
                CurrentDb.Execute strSQL, dbFailOnError
                intRow = intRow + 1         'Increment Row Number
            Loop
            intRow = 2                      'RESET Row Number
          End With
        End If
    Next
    wkb.Close           ' WHERE SHOULD THIS GO? DO I REALLY NEED IT?
Next objFile

appExcel.Quit           ' RIGHT PLACE FOR THIS? REALLY NEEDED?
Set sht = Nothing
Set wkb = Nothing
Set appExcel = Nothing
Set FileSystemObject = Nothing
Set objFolder = Nothing
Set objFile = Nothing

End Sub
Go to the top of the page
 
WildBird
post Jun 27 2018, 08:41 PM
Post#23


UtterAccess VIP
Posts: 3,420
Joined: 19-August 03
From: Auckland, Little Australia


Without reading the code in detail, you have no error handling.

I would call it as a function,

Private Sub btnGetDataFromExcel_Click()
If GetDataFromExcel then
msgbox "Data has been processed",vbinformation, "Success"
End If

You can also use late binding, means you dont have to set reference to anything. The error handling makes sure if anything goes wrong, it will still shut down the Excel files. Because you are reading from these, not writing to them, it is less of an issue, but still best practice. By this I mean if you were writing to an Excel file, and it crashes halfway through, then restarting the code, it might not work because the Excel file is still open and it cant write to it - you usually have to go to Task Manager to shut it down in that case.

CODE
Function GetDataFromExcel() As Boolean
'Date:          Thursday, 28 June 2018 11:32:04 AM
'Author:        Stephen Cooper
'Email:         XXXXXX@XXXXXXXXXX.au
'Ph:
'In parameters
'Output
'Description:
'Calls:
'Notes:
'Example:

On Error GoTo HandleError:

GetDataFromExcel = True

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim sht As Excel.Worksheet
Dim intRow As Integer
Dim strSQL As String
Dim stFileName As String
Dim fso As Object 'Can use late binding.
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String

intMouseType = Screen.MousePointer

DoCmd.Hourglass True

Set objFSO = CreateObject("Scripting.FileSystemObject")

strPath = "C:\Users\lovewilx\Desktop\Alarms\"
Set objFolder = fso.GetFolder(strPath)
'Check if the folder is empty or not
If objFolder.Files.Count = 0 Then
  MsgBox "No files were found...", vbExclamation
  Exit Sub
End If

intRow = 2          'Initiate Row Number
Set appExcel = New Excel.Application

CurrentDb.Execute "DELETE * FROM tblData", dbFailOnError

For Each objFile In objFolder.Files 'Loop thru Files
    stFileName = strPath + objFile.Name
    Set wkb = appExcel.Workbooks.Open(stFileName)
    For Each sht In wkb.Worksheets      'Loop thru Worksheets. If there's one called Top Alarms process it
        If sht.Name = "Top Alarms" Then
          With sht
            Do While .Cells(intRow, "A").Value <> ""       'as long as Data exists in Column 'A'
              strSQL = "INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration], [Project]) VALUES(" & .Cells(intRow, "A").Value & _
                       ", '" & .Cells(intRow, "B").Value & "'" & _
                       ", """ & .Cells(intRow, "C").Value & """" & _
                       ", '" & .Cells(intRow, "D").Value & "'" & _
                       ", '" & .Cells(intRow, "E").Value & "'" & _
                       "," & fConvertDuration(.Cells(intRow, "F").Value) & _
                       ", '" & .Cells(intRow, "G").Value & "'" & ")"
                CurrentDb.Execute strSQL, dbFailOnError
                intRow = intRow + 1         'Increment Row Number
            Loop
            intRow = 2                      'RESET Row Number
          End With
        End If
    Next
    wkb.Close
    Set wkb = Nothing
Next objFile

ExitHere:
On Error Resume Next
'Close all recordsets etc here
varReturn = SysCmd(acSysCmdClearStatus)
Screen.MousePointer = intMouseType
appExcel.Quit           ' RIGHT PLACE FOR THIS? REALLY NEEDED?
Set sht = Nothing
Set wkb = Nothing
Set appExcel = Nothing
Set FileSystemObject = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Exit Function

HandleError:
Select Case Err.Number
Case Else
    LogError "GetDataFromExcel|" & CurrentProject.Name & "|" & strErrorMsg & "|" & Err.Number & " - " & Err.Description & "| Line number " & Erl
    MsgBox strErrorMsg & " " & Err.Number & " " & Err.Description, vbInformation, "Error"
    GetDataFromExcel = False
    'DoCmd.Close acForm, strUpdateForm, acSaveNo
    Resume ExitHere
End Select

End Function


Go to the top of the page
 
ADezii
post Jun 28 2018, 07:46 AM
Post#24



Posts: 2,117
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. Personally, I prefer to avoid the use of External references whenever possible, in this case the File Scripting Object. Why not use the Built-In Dir() Function and call it Recursively?
  2. Code Definition:
    CODE
    '*************** USER DEFINED SECTION ***************
    Const conFILE_PATH As String = "C:\Weekly Alarms\"
    Const conFILE_SPEC As String = "*.xlsx"
    '****************************************************
    Dim strFile As String
    Dim appExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim intRow As Integer

    Set appExcel = New Excel.Application

    strFile = Dir(conFILE_PATH & conFILE_SPEC, vbNormal)

    intRow = 1

    Debug.Print "Sheet Name"; Tab(20); "Value"; Tab(30); "Alarm Type"
    Debug.Print "-----------------------------------------------"

    Do While strFile <> ""
      Set wkb = appExcel.Workbooks.Open(conFILE_PATH & strFile)
      Set wks = wkb.Worksheets(1)       'assumes 1st/single Worksheet
        With wks
          Do While .Cells(intRow, "A") <> ""
            'Simulate Appending Data to Table here
            Debug.Print wkb.Name; Tab(20); .Cells(intRow, "A"); Tab(30); .Cells(intRow, "B")
              intRow = intRow + 1
          Loop
          intRow = 1                    'Reset Row Counter
        End With
        wkb.Close (False): Set wkb = Nothing
                           Set wks = Nothing
        strFile = Dir                   'call Recursively
    Loop

    appExcel.Quit
    Set appExcel = Nothing

    Debug.Print "-----------------------------------------------"
  3. Modify the Constants in the USER DEFINED SECTION if necessary.
  4. OUTPUT (simulates the Append Operation):
    CODE
    Sheet Name         Value     Alarm Type
    -----------------------------------------------
    Friday.xlsx         19       Low pH
    Friday.xlsx         53       Low pH
    Friday.xlsx         22       High Flow
    Friday.xlsx         40       Low Pressure
    Friday.xlsx         14       High Pressure
    Friday.xlsx         75       High pH
    Friday.xlsx         33       Bad Quality
    Monday.xlsx         35       High Pressure
    Monday.xlsx         15       Low Flow
    Monday.xlsx         11       High pH
    Saturday.xlsx       17       Bad Quality
    Saturday.xlsx       19       Good Quality
    Saturday.xlsx       24       High pH
    Saturday.xlsx       38       Low Pressure
    Sunday.xlsx         20       High Pressure
    Sunday.xlsx         10       Bad Quality
    Sunday.xlsx         30       Low pH
    Thursday.xlsx       50       High Pressure
    Thursday.xlsx       24       Low Flow
    Thursday.xlsx       75       Low Pressure
    Thursday.xlsx       11       High pH
    Tuesday.xlsx        15       High pH
    Tuesday.xlsx        27       Low Pressure
    Tuesday.xlsx        32       High Pressure
    Wednesday.xlsx      17       High Pressure
    Wednesday.xlsx      11       Low Pressure
    Wednesday.xlsx      19       Low Pressure
    Wednesday.xlsx      28       Low pH
    Wednesday.xlsx      10       Bad Quality
    Wednesday.xlsx      19       High Flow
    -----------------------------------------------

@RJD:
I would be interested in your opinion regarding the Dir() vs FSO approach concerning this case. Thanks.
This post has been edited by ADezii: Jun 28 2018, 07:48 AM
Go to the top of the page
 
RJD
post Jun 28 2018, 08:12 AM
Post#25


UtterAccess VIP
Posts: 8,943
Joined: 25-October 10
From: Gulf South USA


ADezii:

QUOTE
@RJD:
I would be interested in your opinion regarding the Dir() vs FSO approach concerning this case. Thanks.

I am certainly not expert in this area, and I use the Dir approach when I need to do this with my clients (which is not very often). Sorry I do not have enough experience with FSO to have an informed opinion here ...

Regards,
Joe
Go to the top of the page
 
williamlove
post Jun 28 2018, 01:33 PM
Post#26



Posts: 134
Joined: 8-February 06



RJD (and ADezii): Sorry I missed your post with the function yesterday. The alarm duration is somewhat ambiguous (inaccurate might be a better word) for a couple reasons (which I'll skip). But some of the engineers really like the total duration the way it looks in decimal form as implemented per ADezii. The list and average are not of interest to anyone. But thanks for letting me have that function because I learned some things looking at it and I saved that function.

ADezii: I can't remember why I used FSO years ago but I seem to remember it had a specific advantage that led someone to recommend it for what I was doing. Since you asked RJD about it, I decided to search and I found a thread I found interesting and readable. From a practical standpoint, for me to hand this to someone else, the For Each loop with the FSO is easier to understand because many people don't know what recursion is. But I kept the code you gave me in the same document as my example with the FSO so I can try it.

discussion about Dir vs FSO

Wildbird: Your post led me to a little reading binge on late binding which was a great way to spend time I would have otherwise spent doing work. I also will put in the error handling. Can you (or anyone) tell me if it is actually necessary to do appExcel.Quit at the end just before I destroy appExcel? And while we're at it, why isn't appExcel.Quit done inside the loop since the line of code that opens Excel is in the loop?
Go to the top of the page
 
ADezii
post Jun 28 2018, 01:51 PM
Post#27



Posts: 2,117
Joined: 4-February 07
From: USA, Florida, Delray Beach


QUOTE
why isn't appExcel.Quit done inside the loop since the line of code that opens Excel is in the loop?

The line that Opens each 'Workbook' is inside the Loop. An Instance of Excel is created prior to entering the Loop and that Instance must persist until all Workbooks/Worksheets have been processed. Quitting the Excel Instance inside of the Loop will create a Runtime Error.
This post has been edited by ADezii: Jun 28 2018, 01:53 PM
Go to the top of the page
 
williamlove
post Jun 28 2018, 02:04 PM
Post#28



Posts: 134
Joined: 8-February 06



okay, I think I understand thanks.gif
Go to the top of the page
 
WildBird
post Jun 28 2018, 11:33 PM
Post#29


UtterAccess VIP
Posts: 3,420
Joined: 19-August 03
From: Auckland, Little Australia


Yeah, takes a bit of time to get your head around the object models.
Excel has
Application
Workbook
Worksheet
Range/Cells

So at the top you have your Excel, the actual application. Then you have your individual Workbooks, and within the workbook, they have Worksheets, which of course have the cells, or ranges of cells. Generally you close and set to nothing anything that you create.

You can use GetObject or CreateObject. Get checks if it is already running, create as its name suggests, creates an instance or object. For Excel, I use CreateObject. I may already have Excel open, but I want its own instance for my processing, and I can then close it and it wont affect my other Excel workbooks. appExcel.Quit will shut down the instance you created. Do this at the end, not after each file is processed.

Dir() vs FSO? I use FSO. I just prefer the syntax as I am more used to it and find it easier for what I do. No right or wrong generally, just personal preference. I always use late binding with it FWIW.

Good luck with it!
Go to the top of the page
 
williamlove
post Jun 29 2018, 09:39 AM
Post#30



Posts: 134
Joined: 8-February 06



Since we're in this discussion I may as well ask, what happens if I don't include the line appExcel.Quit before I destroy appExcel? Would an instance of Excel still exist? Would it be unreachable? Just wondering what the difference is between those two actions (quit and destroy).
Go to the top of the page
 
williamlove
post Jul 2 2018, 10:39 AM
Post#31



Posts: 134
Joined: 8-February 06



I have a little problem with quotes again that I have to solve. I am working on it but if someone has a general solution I'd be all ears...

The problem is what to do when a description has one or more double quotes.

One of the other engineers decided to put "A" in one of the descriptions. So the resulting SQL when I reach that record is

QUOTE
INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration], [Project]) VALUES(9, 'CR_RO_FLT_01_FI_01_FAL_01A', "CR-RO-FLT-01 IW FLOW ALARM LOW "A"", 'UPW_241_U', 'CRIT',0.08, 'PRODUCTION')


I teased him about it but I have to be able to handle any data, I think.

Previously, I had encountered the situation of an apostrophe, e.g. HIGH PRESSURE AT FRED'S STATION

CODE
              strSQL = "INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration], [Project]) VALUES(" & .Cells(intRow, "A").Value & _
                       ", '" & .Cells(intRow, "B").Value & "'" & _
                       ", """ & .Cells(intRow, "C").Value & """" & _
                       ", '" & .Cells(intRow, "D").Value & "'" & _
                       ", '" & .Cells(intRow, "E").Value & "'" & _
                       "," & fConvertDuration(.Cells(intRow, "F").Value) & _
                       ", '" & .Cells(intRow, "G").Value & "'" & ")"


The crazy triple and quadruple quotes in the second line of the code above solved the situation if a description was something like "High Pressure at Research's Fifth Station". But now I need to work on it again to handle any situation including when someone forgot to finish double or single quotes, or perhaps mixed both together. Basically any conceivable situation involving single and double quotes. I was thinking of perhaps a preprocessing function to just strip all double and single quotes.

I'm working on it compute.gif But I have a feeling this has been solved before.
This post has been edited by williamlove: Jul 2 2018, 10:42 AM
Go to the top of the page
 
williamlove
post Jul 2 2018, 11:39 AM
Post#32



Posts: 134
Joined: 8-February 06



Found an easy solution

CODE
                strDescription = Replace(.Cells(intRow, "C").Value, Chr(34), "")   ' Strips out ". strDescription will replace .Cells(intRow, "C").Value in the third field below

                strSQL = "INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration], [Project]) VALUES(" & .Cells(intRow, "A").Value & _
                       ", '" & .Cells(intRow, "B").Value & "'" & _
                       ", """ & strDescription & """" & _
                       ", '" & .Cells(intRow, "D").Value & "'" & _
                       ", '" & .Cells(intRow, "E").Value & "'" & _
                       "," & fConvertDuration(.Cells(intRow, "F").Value) & _
                       ", '" & .Cells(intRow, "G").Value & "'" & ")"
Go to the top of the page
 
2 Pages V < 1 2


Custom Search
RSSSearch   Top   Lo-Fi    20th October 2018 - 09:54 AM