☰

Значок папки desktop.ini - пакетный файл - vba

tag-icon • tag-icon windows microsoft-excel vba batch
Значок папки desktop.ini - пакетный файл - vba

Проблема не очень сложная, просто немного сложная, поэтому ее трудно объяснить. Я постараюсь быть максимально ясным.

Я скачал пакетный файл, который позволяет перетаскивать на него папку и он установит новый значок папки. Он делает это, создавая файл desktop.ini и устанавливая необходимые атрибуты файлов и папок.

Вот код в пакетном файле:

If [%1] == [] goto :eof  
ECHO [.ShellClassInfo] >%1\desktop.in  
ECHO IconResource=J:\PRESETS\AUTOHOTKEY SCRIPTS\VSA\ICONS\GREEN\folderico-green.ico,0 >>%1\desktop.in  
move %1\desktop.in %1\desktop.ini  
attrib +S +H %1\desktop.ini  
attrib +R %1

Несмотря на то, что это работает, я добавил строку в конце, чтобы обновить кэш Explorer:

start "C:\Windows\System32" ie4uinit.exe -show

Я хотел запустить этот пакетный файл программно в VBA, поэтому я не мог использовать функцию перетаскивания. Поэтому сначала я изменил все "%1\" на "%~dp0\", чтобы я мог заставить VBA создать пакетный файл в любой папке, и он будет запущен, используя путь к этой папке.

Функция VBA проверяет, является ли баланс клиента >=0. Если это так, папка клиента получит зеленый значок. Если у него есть задолженность, папка получит красный значок.

Функция VBA создаст файл .bat, как показано ранее, в папке клиента и запустит его. Затем она удалит файл .bat.

Вот функция VBA:

Sub ChangeClientFolderIcon(ByVal ClientName As String, ByVal TotalALL As Currency)  

Dim substrings() As String  
Dim NewClientName As String  
substrings = Split(ClientName)  

NewClientName = substrings(2) & "_" & substrings(0) & "_" & substrings(1)  

Dim fso As New FileSystemObject  
Dim f As Folder, sf As Folder  

    Set f = fso.GetFolder("M:\DIGITAL_ALBUMS\")  
    For Each sf In f.SubFolders  

           If sf.name = NewClientName Then  

                Dim MyFile As Variant  
                Dim fnum As Variant  

                MyFile = sf & "\cmdcode.bat"  
                fnum = FreeFile()  
                Open MyFile For Output As #fnum  

                    If TotalALL >= 0 Then    

                        Print #fnum, "If [%~dp0] == [] goto :eof"  
                        Print #fnum, "ECHO [.ShellClassInfo] >%~dp0\desktop.in"  

                    If TotalALL >= 0 Then  
                        Print #fnum, "ECHO IconResource=J:\PRESETS\AUTOHOTKEY SCRIPTS\VSA\ICONS\GREEN\folderico-green.ico,0 >>%~dp0\desktop.in"  
                    Else    
                        Print #fnum, "ECHO IconResource=J:\PRESETS\AUTOHOTKEY SCRIPTS\VSA\ICONS\RED\folderico-red.ico,0 >>%~dp0\desktop.in"  
                    End If  

                    Print #fnum, "move %~dp0\desktop.in %~dp0\desktop.ini"  
                    Print #fnum, "attrib +S +H %~dp0\desktop.ini"  
                    Print #fnum, "attrib +R %~dp0"  
                    Print #fnum, "start ""C:\Windows\System32"" ie4uinit.exe -show"  

                Close #fnum  

                ' Run bat-file:  
                Shell MyFile, vbNormalFocus  

                ' optional, remove bat-file:  

                'Sleep for 5 seconds  
                Application.Wait (Now + TimeValue("0:00:05"))  
                Kill sf & "\cmdcode.bat"  

                Exit For  
          End If  
    Next  
End Sub

Вот в чем проблема:

Если я вручную копирую пакетный файл в клиентскую папку и вручную запускаю его там, он работает нормально. Файл desktop.ini создается, и примерно через 20 секунд значок папки меняется.

Но когда тот же файл создается и запускается функцией VBA, файл desktop.ini создается, но значок папки не меняется.

Надеюсь, мой вопрос был ясен.

решение1

Я понял.

Записываемый пакетный файл устанавливает файл desktop.ini как системный и скрытый (+S +H). Затем он устанавливает саму папку как только для чтения (+R). Для работы пользовательского файла .ini папка также должна быть установлена ​​как системная.

Итак, после изменения этого:

Print #fnum, "attrib +R %~dp0"

к этому:

Print #fnum, "attrib +R +S %~dp0"

все работает отлично!

Связанный контент