2013 Macros in Windows 10

[Dan Wilson]

Good day. Apparently I didn't do the original message correctly, so I will start from scratch.

I am running Excel 2013 on Windows 10. Almost a year ago I copied and edited a macro titled "Read from Explorer" that was offered to me as a response to a question. Its purpose is to read a folder containing 3800 songs and create a listing of those songs. I have not used the macro in quite a while. Several updates from Microsoft have occurred since they updated my OS without my permission. When I try to run the macro now, it starts and within 5 seconds it goes to a blank screen reporting that Excel is no longer working. If I modify the macro to access a folder with only a few files in it, the macro works.

I have also copied below the error message that I am receiving.

"The exception unknown software exception (0xc0000409) occurred in the application at location 0x00000000744A3984".

Below is the macro in question.

'============================================================================================================
'- MACRO TO :-
'- *1. SELECT A FOLDER - *2. CLEAR THE ACTIVE WORKSHEET* - *3. READ .MP3 & .WMA EXTENDED FILE PROPERTIES*
'- ONLY EXTRACTS FILE DATA SO CAN BE USED ON ITS OWN. SHEETS CAN BE SAVED AS NORMAL
'- CAN THEN RUN MACRO "WRITE_TO_EXPLORER" (in another module below) TO *CHANGE* PROPERTIES
'- Uses Windows Shell32.dll (Requires Tools/References .. 'Microsoft Shell Controls And Automation')
'- Brian Baulsom July 2007 - using Excel 2000/Windows XP
' ==========================================================================================================
'- Method (works on all files in a single folder)
'- 1. Run macro "READ_FROM_EXPLORER" below TO GET FILE NAMES INTO CURRENTLY ACTIVE WORKSHEET
'- 2. Manually amend file details in the worksheet.Delete rows for files not changed saves time(can be left)
'- 3. Run macro "WRITE_TO_EXPLORER" (other module)
'===========================================================================================================
Option Base 1    ' MyProperties(15) starts 1 instead of 0
Dim MyFilePathName As String    ' Local variable full path & file name
Public MyPathName As String    ' **Public variable |enables 'Sub GetPathFileNameFromFullPath()'|
Public MyFileName As String    ' **Public variable |usage in 'WRITE_TO_EXPLORER' macro |
'- Properties Array (list of integers)
Dim Arr1 As Variant    ' "Name"= shell property zero + properties in Windows Explorer
' Dim Arr2 As Variant ' some more shell GetDetailsOf() property numbers (0-34 available. 3 unused)
Dim MyProperties(15) As Integer    ' Shell property index numbers used here. Puts them in required order
Dim MyPropertyNum As Integer    ' Array item position 1-15
Dim MyPropertyVal As Variant    ' Lookup Array data shell property numbers 0,16, 17 ... etc.
'-
Dim ws As Worksheet
Dim ToRow As Long    ' write to worksheet row number
'- Shell variables
Dim ShellObj As Shell
Dim MyFolder As Folder
Dim MyFolderItem As FolderItem
'-

'===========================================================================================================
'- MAIN ROUTINE
'===========================================================================================================
Sub READ_FROM_EXPLORER()
'-------------------------------------------------------------------------------------------------------
'- GET FOLDER - Method 1 - using Windows Dialog (comment out if not required)
' MsgBox ("Selecting a single file in the following dialog gets the required *FOLDER*." & vbCr & vbCr _
  ' & "NB. CLEARS THE CURRENTLY ACTIVE SHEET." & vbCr & vbCr _
  ' MyFilePathName =
' Application.GetOpenFilename("Audio Files (*.mp3;*.wma),*.mp3;*.wma", , " GET FOLDER REQUIRED")
' If MyFilePathName = "False" Then Exit Sub
' GetPathFileNameFromFullPath MyFilePathName ' subroutine to separate folder & file name
'-------------------------------------------------------------------------------------------------------
'- GET FOLDER - Method 2 - hard coded for testing (comment out if not required)
    MyPathName = "C:\Users\Daniel\Music\MP3 Normalized"    ' SET AS REQUIRED
' MyPathName = "C:\Users\Daniel\Music\work" ' SET AS REQUIRED
'=======================================================================================================
    Set ShellObj = New Shell
    Set MyFolder = ShellObj.Namespace(MyPathName)
    '------------------------------------------------------------------------------------------
    ChDrive MyPathName
    ChDir MyPathName
    Set ws = ActiveSheet
    ToRow = 2
    ws.Cells.ClearContents    ' clear worksheet
    ws.Cells.Interior.ColorIndex = xlNone
    '-------------------------------------------------------------------------------------------
    '- INITIALISE PROPERTY ARRAY. CLEAR & SET UP WORKSHEET
    '- Set up array to sort properties into the required order
    '- do not change Arr1 (list of changeable fields in Windows Explorer - used in WRITE macro.)
    ' "Name", "Artist", "Album", "Year", "Track", "Genre", "Lyrics", "Title", "Comments")
    Arr1 = Array(21, 13, 16, 15, 26, 27)
    For n = 1 To 6: MyProperties(n) = Arr1(n): Next
    '- "Duration", "Size", "Date Modified", "Category", "Author", "Bit Rate"
    ' Arr2 = Array(35, 36, 37, 38, 39, 40)
    ' For n = 10 To 15: MyProperties(n) = Arr2(n - 9): Next
    '-------------------------------------------------------------------------------------------
    '- write worksheet header
    For n = 1 To 6    '14
        ws.Cells(1, n).Value = MyFolder.GetDetailsOf(MyFolder.Items, MyProperties(n))
    Next
    With ws
        '- "Lyrics" is not included in the Shell properties. I have used a blank one item 27
        '.Cells(1, "G").Value = "Lyrics"
        '- This is useful for other purposes. eg. to play the track via macro.
        '.Cells(1, "O").Value = "Full Name"
        .Range("A1:G1").Interior.ColorIndex = 37    ' Dark blue header 'O1
    End With
    '===========================================================================================
    '- GET FILE NAMES & PROPERTIES FROM FOLDER
    '===========================================================================================
    MyFileName = Dir(MyPath & "*.*")    'first file name
    Do While MyFileName <> ""
        '- filter .MP3 & .WMA
        If UCase(Right(MyFileName, 3)) = "MP3" Or UCase(Right(MyFileName, 3)) = "WMA" Then
            Set MyFolderItem = MyFolder.ParseName(MyFileName)
            '--------------------------------------------------------------------
            '- properties to worksheet
            For MyPropertyNum = 1 To 6    '14
                MyPropertyVal = MyFolder.GetDetailsOf(MyFolderItem, MyProperties(MyPropertyNum))
                ws.Cells(ToRow, MyPropertyNum).Value = MyPropertyVal
            Next
            '---------------------------------------------------------------------
            '- add full path\file name (used as lookup by "WRITE_TO_EXPLORER")
            ws.Cells(ToRow, 7).Value = MyPathName & "" & MyFileName    '15
            ToRow = ToRow + 1
        End If
        MyFileName = Dir    ' Get next file name
    Loop
    '-------------------------------------------------------------------------------------------
    '- finish
    ws.Activate
    ws.UsedRange.Columns.AutoFit
    '- colour editable range -> blue
    If ToRow > 2 Then ws.Range("B2:I" & ws.Range("A2").End(xlDown).Row).Interior.ColorIndex = 34
    ' MsgBox ("Done." & vbCr & "Auto editable properties in blue" & vbCr _
      ' & "used by macro" & vbCr & "'WRITE_TO_EXPLORER'")
End Sub
'=========== END OF MAIN ROUTINE ===============================================================
'===============================================================================================
'- SUB TO SEPARATE PATH & FILE NAME FROM FULL NAME
'- puts to Public module level variables 'MyFileName' & 'MyPathName'
'===============================================================================================
Public Sub GetPathFileNameFromFullPath(Nm As String)
    For C = Len(Nm) To 1 Step -1
        If Mid(Nm, C, 1) = "" Then
            MyFileName = Right(Nm, Len(Nm) - C)
            MyPathName = Left(Nm, Len(Nm) - Len(MyFileName) - 1)
            Exit Sub
        End If
    Next
End Sub
'----------------------------------------------------------------------------------------------

Thank you,
Danno...

 

[mole999]

others have had issues, maybe with adobe installs > https://www.tenforums.com/general-support/32146-what-exception-0xc0000409.html you might also try Microsoft Office Configuration Analyser Tool

 

[Dan Wilson]

Good day mole999. I found the problem. It was not in Excel and not in Windows. Out of 3800 files in the folder, ONE of them turned out to be Read-only. Once I fixed that, the macro is working. I still want to try the Windows Repair function though. My Roboform no longer comes up as it should. Apparently the Configuration Tool does not work unless you have the Office product. All I have is Word and Excel 2013.
Thank you, Danno...