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
> Use Access To Edit Vba In Excel File(s), Access 2016    
 
   
ADezii
post Oct 10 2019, 05:30 PM
Post#21



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


  1. It is crystal clear now, exactly what the problem is. Individual Worksheet Names as exhibited on the Worksheet Tabs and in the Worksheets Collection, is quite different that the Name (CodeName) that Excel uses and so does the Extensibility Library. The following Code will process all Workbooks (*.xlsm) in the C:\PLOGs\ Folder. It will then loop through all the Worksheets in each Workbook and if the Sheet Name = 'WFM PLOG', it will write the Workbook Path, Worksheet Name, and the CodeName to a Table named tblWorkbooks.
  2. All the information that you need now resides in tblWorkbooks. Now, you can process all the Records within a Recordset and pass the information to a Sub-Routine/Function as previously described which now knows exactly where the Find String resides and what it should be replaced with.
  3. Code Definition:
    CODE
    Dim strFileName As String
    Dim appExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim strSQL As String
    '******************* USER DEFINED *******************
    Const conPATH = "C:\PLOGs\"
    Const conFILE_SPEC = "*.xlsm"
    '****************************************************

    CurrentDb.Execute "DELETE * FROM tblWorkbooks", dbFailOnError

    Set appExcel = New Excel.Application
        appExcel.Visible = True

    strFileName = Dir$(conPATH & conFILE_SPEC, vbNormal)

    Do While strFileName <> ""
      Set wkb = appExcel.Workbooks.Open(conPATH & strFileName, , True)
        For Each wks In wkb.Worksheets
          If wks.Name = "WFM PLOG" Then
            CurrentDb.Execute "INSERT INTO tblWorkbooks([Workbook],[Worksheet],[WS_CodeName]) VALUES ('" & _
                            conPATH & strFileName & "','" & wks.Name & "','" & wks.CodeName & "')", dbFailOnError
            'Debug.Print conPATH & strFileName, wks.Name, wks.CodeName
              Exit For
          End If
        Next
        wkb.Close , False
        strFileName = Dir()
    Loop

    appExcel.Quit
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
  4. OUTPUT (tblWorkbooks) after processing 7 Workbooks in the C:\PLOGs\ Folder:
    IDWorkbookWorksheetWS_CodeName
    15C:\PLOGs\Five.xlsmWFM PLOGSheet1
    16C:\PLOGs\Four.xlsmWFM PLOGSheet3
    17C:\PLOGs\One.xlsmWFM PLOGSheet10
    18C:\PLOGs\Seven.xlsmWFM PLOGSheet5
    19C:\PLOGs\Six.xlsmWFM PLOGSheet7
    20C:\PLOGs\Three.xlsmWFM PLOGSheet8
    21C:\PLOGs\Two.xlsmWFM PLOGSheet6
  5. Obviously, this would be a 2-Step process.
  6. I have attached the Demo for your review.

This post has been edited by ADezii: Oct 10 2019, 05:36 PM
Attached File(s)
Attached File  Change_Excel_Code.zip ( 33.19K )Number of downloads: 0
 
Go to the top of the page
 
ADezii
post Oct 11 2019, 09:24 AM
Post#22



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


Finally, I feel that I have come up with a comprehensive system that accomplishes what you have requested.
  1. Create a Folder on your C: Drive named PLOGs, namely C:\PLOGs.
  2. Copy all Workbooks (*.xlsm) into this Folder. Each Workbook shouold have a Worksheet named WFM PLOG. Each WFM PLOG will have the following Code in its Change() Event:
    CODE
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range

    If Not Intersect(Target, Range("A:CR")) Is Nothing Then
      For Each c In Target
        If c.Value <> "" Then Cells(c.Row, c.Column + 255) = Now()
      Next
    End If
    End Sub
  3. Open the Change Excel Code.mdb Database (attached).
  4. Click Step1: Populate tblWorkbooks.
  5. Once this process has completed, click on Step2: Replace Excel Code.
  6. The Code in the Change() Event of the WFM PLOG Worksheets of all Workbooks in the C:\PLOGs Folder will now be (255 ==> 256):
    CODE
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range

    If Not Intersect(Target, Range("A:CR")) Is Nothing Then
      For Each c In Target
        If c.Value <> "" Then Cells(c.Row, c.Column + 256) = Now()
      Next
    End If
    End Sub
  7. I would definitely process blocks of Workbooks at a time as opposed to all 500+. If you do take this approach, remember to remove/comment the following line of Code in Step1:
    CODE
    CurrentDb.Execute "DELETE * FROM tblWorkbooks", dbFailOnError
  8. tblWorkbooks should then contain the list of Workbooks that have been processed.
  9. Keep in mind that these processes are time and CPU sensitive and take quite awhile to complete.

This post has been edited by ADezii: Oct 11 2019, 09:28 AM
Attached File(s)
Attached File  Change_Excel_Code.zip ( 29.92K )Number of downloads: 1
 
Go to the top of the page
 
aggiemarine07
post Oct 11 2019, 01:59 PM
Post#23



Posts: 59
Joined: 7-January 11



@ADezii - amazing! worked like a charm, thanks!
Go to the top of the page
 
ADezii
post Oct 11 2019, 02:43 PM
Post#24



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


yw.gif , this one was very challenging, but we got it, I think? iconfused.gif Next, I will try to optimize the Code in an attempt to make the processing time much faster. I'll be in touch. Actually, I came right back and made a simple change that should significantly increase the processing time of Step 2. Kindly test the Revision for me and let me know if there was any noticeable improvement. Thanks.
This post has been edited by ADezii: Oct 11 2019, 03:08 PM
Attached File(s)
Attached File  Change_Excel_Code_Revised.zip ( 32.71K )Number of downloads: 0
 
Go to the top of the page
 
aggiemarine07
post Yesterday, 06:32 AM
Post#25



Posts: 59
Joined: 7-January 11



@ADezii - Well I always like posing challenging questions, especially when it's me not fully thinking through the problem and then trying to come up with a solution after the fact smile.gif I'll be sure to test it out when I get back to the office on Wednesday...more to follow
Go to the top of the page
 
2 Pages V < 1 2


Custom Search


RSSSearch   Top   Lo-Fi    15th October 2019 - 03:44 AM