Reemplazar texto en el código VBA de archivos de Excel

Question

tenemos varias decenas de archivos Excel habilitados para macros, cada uno de los cuales contiene pocos módulos VBA y en cada uno de esos módulos hay nombres de servidor SQL y userid/contraseñas del inicio de sesión sql.

Me pregunto si podría escribir algún tipo de utilidad C# que cargue esos archivos uno por uno y con .NET-Office Interop. o cualquier otro enfoque reemplazar esas cadenas con otra cosa ... solo porque tengo que volver a marcar todas las macros de VBA a otro nombre de servidor y usar otro nombre de usuario y contraseña de SQL ... Realmente no me gustaría hacer este reemplazo por mano :(:(:(

gracias!

Answer 1

Para empezar

Lo siento por tomar algún tiempo en publicar pero estaba creando una interfaz de usuario para que de modo que no sólo le ayuda, pero cualquier otra persona que viene en busca de la misma funcionalidad.

Necesita habilitar primera Trust Access to the VBA project Object model

Abra Excel y haga clic en la ficha Archivo | Opciones | Centro de confianza | Configuración del Centro de confianza | Configuración de macros

Habilitar macro y haga clic en Trust access to Visual Basic projects

Siguiente En VBA Editor

Haga clic en la herramienta | Opciones y bajo el "Editor" Tab seleccionar la casilla de verificación Require Variable Declaration

Siguiente Descarga el archivo de ejemplo de here y simplemente pulse el botón Run En Hoja1 para poner en marcha el formulario de usuario, como se muestra a continuación.

Simple seleccione la carpeta que tiene SOLAMENTE Archivos de Excel.Introduzca la información correspondiente y haga clic en Start Replace y ya está :)

código utilizado

Hoja1 Código de área

Option Explicit 

Private Sub CommandButton1_Click() 
    UserForm1.Show 
End Sub 

Código formUsuario Área

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 

SNAPSHOTS MÁS

archivo cuyo código debe ser reemplazado antes de la macro se ejecuta

Después de ejecutar la macro

EDITAR

archivo alternativo ubicación de descarga

En caso de que el enlace de arriba wikisend muere, el archivo se puede descargar desde here

Answer 2

sugiero crear un archivo de configuración que incluye los nombres de servidor y las credenciales. a continuación se añade un módulo a cada uno de los archivos de Excel que analiza este archivo de configuración al inicio y llena las variables globales con él. Solo tiene que ajustar las variables para el nombre del servidor, etc. en todos sus módulos de VBA a las nuevas variables globales.

De esta manera puede cambiar sus datos de acceso en cualquier momento que desee simplemente editando o reemplazando el archivo de texto.

Answer 3

propongo esta manera de resolver su problema. Puede crear proyectos vba o vbscript separados que cargarán todas las hojas de cálculo una a una, exportando los contenidos de sus proyectos vba a archivos de texto separados. Luego puede cargar esos archivos de texto y realizar reemplazos de cadenas. Posteriormente, puede importar archivos de texto a la hoja de cálculo como componentes del proyecto vba (mediante la simple reversión del proceso de exportación).

Usted puede utilizar este código como éste para la exportación de los componentes:

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