Printable Version of Topic

Click here to view this topic in its original format

UtterAccess Forums _ Access Searching + Data Mining _ Aggregating Data In Spreadsheets (simple Example)

Posted by: williamlove Jun 25 2018, 11:28 AM

This is a real problem I'm working. I have not simplified it much...it is a simple problem already.
At the end of every week seven spreadsheets are provided each containing information about the number of alarms received each day. Three of the sheets are shown below to illustrate. I intend to import them into access and add up the totals of each alarm that appeared.

Sheet Monday
35 High Pressure
15 Low Flow
11 High pH

Sheet Tuesday
15 High pH

Sheet Wednesday
17 High Pressure
11 Low Level
19 Low Pressure
28 Low pH
10 Bad Quality
19 High Flow

There is no minimum or maximum number of rows in a sheet for a given day...it just depends on what happened that day. Typically several of the alarms appear every day while others appear only occasionally.

I want to add up the total number of occurrences of each alarm for the week. If an alarm appears even one day it would make the report. If an alarm occurred everyday the report would add them up and give the sum. (I say "report" but an Access table or Query would be okay.)

Can you explain how you would import the spreadsheets into a database and use SQL or some standard technique to do this?
It would be nice if the method was amenable to VBA automation because I hope to do that after I master the method from a manual standpoint.

Posted by: kfield7 Jun 25 2018, 12:53 PM

I assume each sheet has the number of events in Col A, and the name of the event in col B?

I would use VBA. Many ways to accommodate the details, so here's an overview in psuedocode:


CODE
clear holding table
for each workday spreadsheet
    append SS to holding table (e.g., use transferspreadsheet method.)
next
view holding table - QA check
approve/append holding table to main table


then run your query(ies) as desired.

Let us know if you need help with the detail.

Posted by: williamlove Jun 25 2018, 01:18 PM

Yes Col A and Col B are as you said. And I will use VBA to automate it after I understand how to do it manually. Since you gave me a little algorithm, I will try to get started by creating a project that makes the holding table, just to get warmed up. As I understand it, I will create a holding table of two fields (event and number of occurrences) and the loop will populate it with a number of records equal to the sum of the number of rows (minus headers) that exist in seven raw sheets. The transferspreadsheet method appears to be what I need.

I have actually created the holding table manually in Excel. That is when I realized I don't know how to get the totals. I'm sure it's elementary but I've never done it. So yes, it is that detail that I'm most weak on. I don't have a background it that sort of thing.

So lets say my holding table looks like this:

35 High Pressure
15 Low Flow
11 High pH
15 High pH
12 Bad Quality
17 High Pressure
11 Low Level
19 Low Pressure
28 Low pH
10 Bad Quality
19 High Flow
10 Low Flow

The "query" would produce this:

52 High Pressure
25 Low Flow
27 High pH
22 Bad Quality
11 Low Level
19 Low Pressure
28 Low pH
19 High Flow

I did that by adding in my head and typing. Where I am lacking knowledge is how to do that with a query. If you can explain that I think I can automate it once I can do it. Thanks!

Posted by: RJD Jun 25 2018, 01:27 PM

Hi: You would use a Totals (Group By) query to do this ... Something like this ...

SELECT Alarm, Sum(Frequency) AS SumOfFrequency
FROM tblMyRecords
GROUP BY Alarm
ORDER BY Alarm;

...using you own object names, of course.

See the demo attached.

HTH
Joe

 AggregatingData.zip ( 18.22K ): 12
 

Posted by: projecttoday Jun 25 2018, 01:40 PM

Are those the entire sheets?

Posted by: williamlove Jun 25 2018, 01:47 PM

notworthy.gif Thanks everyone, that's good help.
kfield7 -- I will try the DoCmd.TransferSpreadsheet and see if I can make the holding table.
RJD -- I got your file and I am studying the query. I will learn a lot from it.

Posted by: RJD Jun 25 2018, 01:57 PM

Be sure to let us know how this works out for you and if we can be of further assistance.

Regards,
Joe

Posted by: ADezii Jun 25 2018, 02:24 PM

QUOTE
It would be nice if the method was amenable to VBA automation because I hope to do that after I master the method from a manual standpoint.

  1. The entire process can be reduced to a few simple steps totally within Access:
    1. Create a Table named tblData with two Fields, namely: [Alarms]-{INT} and [Type]-{STRING}.
    2. From Access, open the Excel Workbook (Alarms.xlsx), clear tblData, iterate each Worksheet (Monday thru Sunday), and copy the Alarms and Type Data directly into tblData.
    3. Perform a few Clean UP chores.
    4. Execute the Aggregate Query as suggested by RJD.
  2. Code Definition:
    CODE
    '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

    Set appExcel = New Excel.Application
    'Change PATH and/or Filename if necessary
    Set wkb = appExcel.Workbooks.Open("C:\Test\Alarms.xlsx")

    intRow = 1          'Initiate Row Number

    'CurrentDB.Execute "DELETE * FROM tblData", dbFailOnError

    For Each sht In wkb.Worksheets      'Loop thru all Worksheets
      With sht
      Do While .Cells(intRow, "A").Value <> ""       'as long as Data exists in Column 'A'
        'strSQL = "INSERT INTO tblData([Alarm], [Type]) VALUES(" & .Cells(intRow, "A").Value & _
                 '", '" & .Cells(intRow, "B").Value & "')"
          'CurrentDB.Execute strSQL, dbFailOnError
          Debug.Print .Name, .Cells(intRow, "A"), .Cells(intRow, "B")
            intRow = intRow + 1         'Increment Row Number
      Loop
        intRow = 1                      'RRESET Row Number
      End With
    Next

    wkb.Close
    appExcel.Quit
    Set sht = Nothing
    Set wkb = Nothing
    Set appExcel = Nothing

    'You can Run the Aggregate Query as suggested by RJD here
  3. The Code has been tested and is fully operational except the Deletion of the Records in tblData and the actual Appending of the Records to tblData. This is only because I am in work and do not have Access on my PC, only Excel.

Posted by: williamlove Jun 26 2018, 01:26 PM

QUOTE
The entire process can be reduced to a few simple steps totally within Access


ADezii: I'm getting ready to try to use your code. I'll let you know how I do. I created frmData whose Record Source is tblData. I have six fields in the "real" data, not the two I used as my example. So I have to use the code as a guide. But that should not be too hard.

The only thing I might ask now is where should the code go?

At the moment my plan is to put a button on the form and run the code from that. Unless there is a better idea.

Posted by: ADezii Jun 26 2018, 01:47 PM

QUOTE
is where would you put the code?

  1. The most logical location for the Code is within the Click() Event of a Command Button on a Form.
  2. Keep in mind some 'very important' points before you proceed:
    1. You need to change the following line of Code to point to the location of Alarms.xlsx on your PC.
      CODE
      Set wkb = appExcel.Workbooks.Open("C:\Test\Alarms.xlsx")
    2. You need to create tblData and two Fields exactly as described above.
    3. Each Worksheet in Alarms.xlsx, there should be seven of them corresponding to the days of the week, should have the same Format. The names of the Worksheets make no difference as long as there are seven of them and they are all consistent with each other.
    4. The Worksheets should have no Row Headers. If this is not the case then you must change the Value of intRow to reflect a Starting Row = 2.
    5. Column 'A' on each Worksheet must contain the Values and they must be Numeric.
    6. Column 'B' on each Worksheet must contain the Alarm Types and they must all be named exactly the same (Bad Quality <> Bad Qualtry).
    7. The Data in Columns A and B must be contiguous, there can be no missing/empty Rows.
  3. Should you run into any problems, we are here for you.
  4. Good Luck with your Project.

P.S. - One point I am sure on is to whether or not the Records need to be DELETED each and every time that this Code is run. Only you can answer this question.

Posted by: williamlove Jun 26 2018, 04:50 PM

I have gotten far enough that I'm certain your code will work. I am dealing with a number of issues. I am sure I will solve them all.

One problem is that one of the fields is a duration and the cell has a custom format in Excel [h]:mm:ss. The data looks like this when you look at it in Excel: 0:10:01 (the alarm was in active state a total duration of ten minutes and one sec on that day)
I temporarily avoided this problem by only reading the first five fields (the duration is the sixth field). I intend to come back to this and solve this later.

The next problem is the routine failed with a message about a missing operator. But it populated hundreds of records before failing. Then I realized that when my Description field has a single quote the

QUOTE
CurrentDB.Execute strSQL, dbFailOnError
fails.
This is the offending entry in the field that caused the failure: CH7-PIT212-0-02A OFA PRESSURE TO AHU'S LOW
I think I can figure out a solution to that. That is what I am working on now.

As I say this is clearly going to work.

Posted by: williamlove Jun 26 2018, 06:57 PM

I got the duration to come in by changing the field in my table to date/time with h:mm:ss

I did some crazy stuff with double quotes to get it to accept a description that had an apostrophe in column C. Note the especially insane looking quadruple quote on the right side of the "C" field. I can't say I understand. But it works. If you understand it well and you want to explain it to me please feel free. I knew about the technique of adding double quotes but don't really understand that one.

CODE
  Do While .Cells(intRow, "A").Value <> ""       'as long as Data exists in Column 'A'
    strSQL = "INSERT INTO tblData([AlarmCount], [Point], [Description], [Resource], [AlarmClass], [TotalDuration]) VALUES(" & .Cells(intRow, "A").Value & _
             ", '" & .Cells(intRow, "B").Value & "'" & _
             ", """ & .Cells(intRow, "C").Value & """" & _
             ", '" & .Cells(intRow, "D").Value & "'" & _
             ", '" & .Cells(intRow, "E").Value & "'" & _
             "," & .Cells(intRow, "F").Value & ")"
       'Debug.Print strSQL
            
      CurrentDb.Execute strSQL, dbFailOnError
      Debug.Print .Name, .Cells(intRow, "A"), .Cells(intRow, "B"), .Cells(intRow, "C"), .Cells(intRow, "D")
        intRow = intRow + 1         'Increment Row Number
  Loop


Now my next task is to use the query that RJD gave me to design one for all six fields and the varied formatting. Then I will figure out where to put that query....another button? I have to think about that. But I'm definitely cruising along. Thanks!
thumbup.gif

Posted by: RJD Jun 26 2018, 07:15 PM

QUOTE
Then I will figure out where to put that query....another button?

I would think you would want the results in a report. If this is correct, design the report with the query as the record source - and open the report (command button) (preview) when you want it - it will call the query by itself and present the data as you design it in the report.

The trick in all this will be how you want to deal with the alarm duration. You have formatted the duration as a point-in-time rather than as a duration. If it is text (or even a "time"), you will have to parse the components (hours, minutes, seconds), changing each component to a common measure (seconds) to add the values across the record group, then convert the result in the total to the format you want to see - known processes, but not especially trivial. There should be some code already around here somewhere to do both of these, or it can be constructed to your specific requirements.

HTH
Joe

Posted by: ADezii Jun 27 2018, 07:55 AM

@williamlove:
It does appear that you have the situation well in hand, congratulations! thumbup.gif

  1. RJD does bring up some excellent points in Post# 13, Paragraph 2 regarding your [Duration] Field. In its present state you can do very little with it: you cannot add Durations, Aggregate them, etc. What you can do is to Convert these point-in-time Values to something more meaningful prior to actually bringing this Data into Access. As an example, I have converted the [Duration] Field which has a [h]:mm:ss Custom Format into a SINGLE Data Type Field via a Conversion Function. The whole number component is the Duration in Minutes, while the Fractional component represents Seconds as a percentage of a Minute (the ss in [h]:mm:ss). A SINGLE Data Field can now exist in tblData and mathematical operations can now be performed on it.
  2. Sample Data (Friday Worksheet) prior to conversion:
    CODE
    19    Low pH            0:13:23
    53    Low pH            1:02:58
    22    High Flow         0:00:45
    40    Low Pressure      2:47:00
    14    High Pressure     0:17:37
    75    High pH           0:16:00
    33    Bad Quality       3:00:00
  3. Function Code Definition:
    CODE
    Public Function fConvertDuration(varDuration As Variant) As Single
    Const conMult = 60
    Dim sngMins As Single

    sngMins = Format((Hour(varDuration) * conMult) + Minute(varDuration) + (Second(varDuration) / conMult), "Fixed")

    fConvertDuration = sngMins
    End Function
  4. Post conversation:
    CODE
    19    Low pH            0:13:23      13.38
    53    Low pH            1:02:58      62.97
    22    High Flow         0:00:45       0.75
    40    Low Pressure      2:47:00     167.00
    14    High Pressure     0:17:37      17.62
    75    High pH           0:16:00      16.00
    33    Bad Quality       3:00:00     180.00
  5. Obviously, you will need to adjust your SQL Statement (AIR CODE - NOT TESTED):
    SQL
    strSQL = "INSERT INTO tblData([Alarm], [Type], [Duration]) VALUES(" & .Cells(intRow, "A").Value & _
    ", '" & .Cells(intRow, "B").Value & "', " & fConvertDuration(.Cells(intRow, "B").Value) & ")"

    CurrentDB.Execute strSQL, dbFailOnError

RJD: If I happened to misinterpret anything I said regarding your Post# 13, please let me know, and I do apologize.

Posted by: RJD Jun 27 2018, 09:32 AM

ADezii

QUOTE
RJD: If I happened to misinterpret anything I said regarding your Post# 13, please let me know, and I do apologize.

Not at all. Perfect. I did not know if the OP had the time as a text field or point-in-time date/time format, so stopped short of a suggested parsing/summing solution - just some general comments. You went further with a solution, which is perfect. If the field is actually text, however, then it will have to be converted or parsed and calculated accordingly, but you led the way to the solution.

Thanks for stepping in on this ...

Regards,
Joe

Posted by: ADezii Jun 27 2018, 10:07 AM

  1. Thanks Joe. My initial approach, assuming the Duration Values were TEXT, was to Parse them as follows:
    CODE
    Split("[h]:mm:ss", ":")(0)      'hour
    Split("[h]:mm:ss", ":")(1)      'minute
    Split("[h]:mm:ss", ":")(2)      'second
  2. Had problems getting this to work, so I took the alternative approach.

Posted by: williamlove Jun 27 2018, 12:08 PM

 AggregatingData.zip ( 101.13K ): 8
I have a new problem with my query. I will explain the problem at the bottom. First I will mention that ADezii's function to convert the duration to a decimal number worked and my current problem is not in any of the VBA code. For reference, here is the code that successfully produces a table from the worksheets:

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

Set appExcel = New Excel.Application
'Change PATH and/or Filename if necessary
Set wkb = appExcel.Workbooks.Open("C:\Users\lovewilx\Desktop\Alarms.xlsx")

intRow = 2          'Initiate Row Number

CurrentDb.Execute "DELETE * FROM tblData", dbFailOnError

For Each sht In wkb.Worksheets      'Loop thru all Worksheets
  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                      'RRESET Row Number
  End With
Next

wkb.Close
appExcel.Quit
Set sht = Nothing
Set wkb = Nothing
Set appExcel = Nothing

Public Function fConvertDuration(varDuration As Variant) As Single
Const conMult = 60
Dim sngMins As Single
sngMins = Format((Hour(varDuration) * conMult) + Minute(varDuration) + (Second(varDuration) / conMult), "Fixed")
fConvertDuration = sngMins
End Function
End Sub


The code above produces a table with seven fields. Eight if you include the Autonumber ID. Six of the seven fields--including the decimal duration--are ShortText. The AlarmCount is a number.

My problem is that my query works fine if I don't include Duration. As soon as I add Duration it stops aggregating the data. I left RJD's table and query in the database. My table, form and query are called tblData, frmData, qryData.
I am continuing to work on the problem but its so cut and dry that I'm very puzzled. Esp since Duration is a text item.

Posted by: RJD Jun 27 2018, 12:30 PM

Hi: I tested your query by adding TotalDuration to the query and choosing Sum as the aggregation. It added the text values without issue, converting the text to numeric.

But if you want to be safe (I did this in A2010) in your version of Access, then you might try ...

Sum(CDbl([TotalDuration])) AS DurationTotal

or even ...

Sum(CDbl(NZ([TotalDuration],0))) AS DurationTotal ... to deal with nulls if necessary

Try one of these and see how it goes.

HTH
Joe

Posted by: williamlove Jun 27 2018, 01:15 PM

Your solution worked.

I will mention, the goal of this task was to look at nuisance alarms which are alarms that go off too often. So the AlarmCount is what me and the other engineers want. The duration is of limited interest because its meaning can be ambiguous for reasons I won't delve into. But it is not irrelevant and I'm glad to have it.

Until your post just now, it had just not occurred to me that the duration should be summed too. The other fields are the same for each record of an alarm which is why the aggregate works when they are all that's included. But the duration varies and that obviously is noticed by Access. Pretty impressive what the database designers have done.

I have been using the design view of the query. I added TotalDuration, changed "Group By" to "Sum" in the Total row. It worked. The AlarmTotals are the same as without including the duration and the duration gets summed. Pretty cool. I don't understand the SQL yet, at least not more than needed to fiddle with it a little. But I am studying it.

I might automate the initial task (manually done, not mentioned before) of making a single workbook with seven worksheets from seven separate workbooks. In my initial post I called them spreadsheets and everyone assumed I meant worksheets. But what I actually start with is seven workbooks. After you guys started helping I made a single workbook so that I could use ADezii's code. I am thinking I might put the workbooks in a folder and have a loop similar to the one I have now. I have a feeling I won't be able to use the nice For Each loop, because they are files, not Excel objects. I'm going to take a shot at this because its kind of fun and would make it a more complete solution.

Thanks to both of you for your continued interest, it has been extremely helpful! notworthy.gif

Posted by: ADezii Jun 27 2018, 01:53 PM

First and foremost, it has been a pleasure working with you on this Project, good luck on its completion.

QUOTE
I am thinking I might put the workbooks in a folder and have a loop similar to the one I have now. I have a feeling I won't be able to use the nice For Each loop, because they are files, not Excel objects. I'm going to take a shot at this because its kind of fun and would make it a more complete solution.

  1. I do not think that this will be as difficult as it might seem.
  2. One possible solution could be:
    1. Load a 'MultiSelect' ListBox with your Workbook Names along with a hidden Column that contains their Absolute PATHs. These Names and PATHs can be stored in a Hidden Table.
    2. Select 1 or more of the Workbooks in the ListBox.
    3. Process each of the Workbooks that you selected. Here is where you can use the For...Each Loop that you mentioned, the Pseudo Code being:
      CODE
      Dim varItem As Variant

      For Each varItem in ListBoxName.ItemsSelected   'Workbook Names contained in the ItemsSelected Collection
        'process in turn
      Next
  3. For each Workbook in the For Each...Next Loop, you would simply reassign the Workbook and Worksheet Object Variables, then extract the Data from each in turn.
  4. Should you need a simple Demo, I would be more than happy to assist.
  5. Good Luck again with your Project.

Posted by: RJD Jun 27 2018, 02:37 PM

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

 AggregatingData_Rev1.zip ( 78.23K ): 10
 

Posted by: williamlove Jun 27 2018, 06:42 PM

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

Posted by: WildBird Jun 27 2018, 08:41 PM

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



Posted by: ADezii Jun 28 2018, 07:46 AM

  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.

Posted by: RJD Jun 28 2018, 08:12 AM

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

Posted by: williamlove Jun 28 2018, 01:33 PM

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.

https://www.experts-exchange.com/questions/21347632/Dir-versus-FSO.html

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?

Posted by: ADezii Jun 28 2018, 01:51 PM

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.

Posted by: williamlove Jun 28 2018, 02:04 PM

okay, I think I understand thanks.gif

Posted by: WildBird Jun 28 2018, 11:33 PM

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!

Posted by: williamlove Jun 29 2018, 09:39 AM

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).

Posted by: williamlove Jul 2 2018, 10:39 AM

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.

Posted by: williamlove Jul 2 2018, 11:39 AM

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 & "'" & ")"