Замена текста в коде VBA файлов Excel

У нас есть несколько десятков файлов excel с поддержкой макросов, каждый из которых содержит несколько модулей VBA, и в каждом из этих модулей есть имена SQL server и идентификатор пользователя/пароли входа sql.

интересно, могу ли я написать какую-то утилиту C#, которая загружает эти файлы один за другим и либо с .NET-Office Interop. или любой другой подход заменит эти строки чем-то другим... просто потому, что я должен переадресовать все эти макросы VBA на другое имя сервера и использовать другое имя входа и пароль sql... Я действительно не хотел бы делать эту замену вручную :( :( :(

спасибо!

6
.net c# excel-vba office-interop vba

3 ответов

для начала

Извините, что занял некоторое время в публикации, но я создавал пользовательский интерфейс для него, чтобы он не только помог вам, но и всем, кто ищет ту же функциональность.

вам нужно сначала включить Trust Access to the VBA project Object model

откройте Excel и нажмите на вкладку Файл / Параметры / Центр доверия / настройки Центра доверия / настройки макроса

включить макрос и нажмите на кнопку Trust access to Visual Basic projects

enter image description here

далее в VBA Редактор

нажмите на инструмент / параметры и на вкладке "редактор" установите флажок Require Variable Declaration

enter image description here

далее загрузите пример файла из здесь и просто нажать Run кнопка в Sheet1 для запуска userform, как показано ниже.

просто выберите папку, которая имеет только Файлы Excel. Введите соответствующую информацию и нажмите на кнопку Start Replace и вы сделали :)

enter image description here

Код

Код Лист1

Option Explicit

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

Область Кода Userform

Option Explicit

Private Sub CommandButton1_Click()
    Dim Ret
    Ret = BrowseForFolder
    If Ret = False Then Exit Sub
    TextBox1.Text = Ret
End Sub

Private Sub CommandButton3_Click()
    On Error GoTo Whoa

    Dim wb As Workbook
    Dim strPath As String, strfile As String
    Dim strToReplaceWith As String, strToReplace As String
    Dim i As Long, j As Long

    Dim VBE As Object

    strPath = TextBox1.Text & "\"

    strfile = Dir(strPath)

    While strfile <> ""
        Set wb = Workbooks.Open(strPath & strfile)

        Set VBE = ActiveWorkbook.VBProject

        If VBE.VBComponents.Item(1).Properties("HasPassword").Value = False Then
            If VBE.VBComponents.Count > 0 Then
                For i = 1 To VBE.VBComponents.Count
                    VBE.VBComponents.Item(i).Activate

                    If VBE.VBE.CodePanes.Item(i).CodeModule.CountOfLines > 0 Then
                        For j = 1 To VBE.VBE.CodePanes.Item(i).CodeModule.CountOfLines
                            If InStr(1, VBE.VBE.CodePanes.Item(i).CodeModule.Lines(j, 1), TextBox2.Text, vbTextCompare) Then
                                strToReplace = VBE.VBE.CodePanes.Item(i).CodeModule.Lines(j, 1)
                                strToReplaceWith = Replace(strToReplace, TextBox2.Text, TextBox3.Text, 1, 1, vbTextCompare)
                                VBE.VBE.CodePanes.Item(i).CodeModule.ReplaceLine j, strToReplaceWith
                            End If
                        Next
                    End If
                Next i
            End If
        End If

        wb.Close True

        strfile = Dir
    Wend

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to pop the browse folder dialog
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object

    '~~> Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    '~~> Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    '~~> Destroy the Shell Application
    Set ShellApp = Nothing

    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
    BrowseForFolder = False
End Function

Private Sub CommandButton4_Click()
    Unload Me
End Sub

БОЛЬШЕ СНИМКОВ

enter image description here

файл, код которого необходимо заменить перед запуском макроса

enter image description here

после макроса запустить

enter image description here

редактировать

АЛЬТЕРНАТИВНОЕ РАСПОЛОЖЕНИЕ ЗАГРУЗКИ ФАЙЛА

в случае, если вышеуказанная ссылка wikisend умирает, файл можно загрузить из здесь

11

Я предлагаю вам создать файл конфигурации, который включает ваши имена серверов и учетные данные. Затем вы добавляете модуль в каждый из ваших файлов Excel, который анализирует этот файл конфигурации при запуске и заполняет им глобальные переменные. Вам просто нужно настроить переменные для имени сервера и т. д. во всех ваших модулях VBA к новым глобальным переменным.

таким образом, вы можете изменить данные доступа в любое время, просто отредактировав или заменив текстовый файл.

5

Я предлагаю этот способ решения вашей проблемы. Вы можете создать отдельный проект vba или vbscript, который будет загружать все электронные таблицы один за другим, экспортируя содержимое своих проектов vba в отдельные текстовые файлы. Затем вы можете загрузить эти текстовые файлы и выполнить замену строк. После этого вы можете импортировать текстовые файлы обратно в электронную таблицу в качестве компонентов проекта vba (путем простого возврата процесса экспорта).

вы можете использовать этот код как этот для экспорта компоненты:

Public Sub ExportAppSrcs(targetWb as Workbook)
Dim wb As Workbook, Component As Object, Suffix As String, fileName As String

Set wb = targetWb
    For Each Component In wb.VBProject.VBComponents

        Select Case Component.Type
            Case 1                  'modul
                Suffix = ".bas"
            Case 2                  'class modul
                Suffix = ".cls"
            Case 3                  'form
                Suffix = ".frm"
            Case 100                'dokument
                Suffix = ".xwk"
            Case Else
                Suffix = ""
        End Select

        If Suffix <> "" Then
            On Error Resume Next
            fileName = wb.Path & "\spreadsheet.xlsm.src\" & Component.name & Suffix
            Component.Export fileName
        End If
    Next 
End Sub
0