2012-09-18 64 views
5

He escrito un Sub de VBA (a continuación) que se supone que abre todos los archivos .docx y/oxx en un directorio determinado. realice una operación de búsqueda/reemplazo y luego sobrescriba los archivos originales con los nuevos. Esto funciona según lo previsto en otro momento, se ejecuta para un archivo .xlsx, y arroja el error "Método 'Hojas' del objeto '_Global' falló" cada dos veces. Este es mi primer intento de programar en VBA, por lo que probablemente haya una respuesta muy simple que simplemente no puedo ver. Se rompe en la línea de código: "Para i = 1 Para oWB.Sheets.Count""Hojas de trabajo del método 'del objeto' _global 'error" en cada ejecución

Gracias por mirar

Option Explicit 
Public SearchPhrase As String 
Public ReplacePhrase As String 

Sub StringReplacer() 

Dim fd As FileDialog 
Dim PathOfSelectedFolder As String 
Dim SelectedFolder 
Dim SelectedFolderTemp 
Dim MyPath As FileDialog 
Dim fs 
Dim ExtraSlash As String 
ExtraSlash = "\" 
Dim MyFile 
Dim rngTemp As Range 
Dim MinExtensionX As String 
Dim arr() As Variant 
Dim lngLoc As Variant 
Dim oExcel As New Excel.Application 
Dim oWB As Excel.Workbook 
Dim ws As Worksheet 
Dim i As Integer 
Dim doc As String 
Dim xls As String 
Dim redlines As String 

'get desired file extensions from checkboxes in GUI and put them into an array 
doc = ActiveDocument.FormFields("CKdocx").CheckBox.Value 
If doc = True Then 
    doc = "docx" 
Else 
    doc = " " 
End If 
xls = ActiveDocument.FormFields("CKxlsx").CheckBox.Value 
If xls = True Then 
    xls = "xlsx" 
Else 
    xls = " " 
End If 
arr = Array(doc, xls) 

'set redlines variable from redlines checkbox in GUI 
redlines = ActiveDocument.FormFields("CKredlines").CheckBox.Value 

'Prepare to open a modal window, where a folder is selected 
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker) 
With MyPath 
    'Open modal window 
    .AllowMultiSelect = False 
    If .Show Then 
     'The user has selected a folder 
     'Loop through the chosen folder 
     For Each SelectedFolder In .SelectedItems 
      'record name of the selected folder 
      PathOfSelectedFolder = SelectedFolder & ExtraSlash 
      Set fs = CreateObject("Scripting.FileSystemObject") 
      Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder) 
      'Loop through the files in the selected folder 
      For Each MyFile In SelectedFolderTemp.Files 
       'grab extension of file 
       MinExtensionX = Mid(MyFile.Name, InStrRev(MyFile.Name, ".") + 1) 
       'check to see if extension of the file is in the accepible list 
       If IsInArray(MinExtensionX, arr) Then 

        If MinExtensionX = "docx" Then 
         'Open the Document (.docx) 
         Documents.Open FileName:=PathOfSelectedFolder & MyFile.Name 
         'turn off "track changes" if that option was selected 
         If redlines = True Then 
         ActiveDocument.TrackRevisions = False 
         ActiveDocument.Revisions.AcceptAll 
         End If 
         'replace all keyphrases (.docx) 
         Set rngTemp = ActiveDocument.Content 
         With rngTemp.Find 
          .ClearFormatting 
          .Replacement.ClearFormatting 
          .MatchWholeWord = True 
          .Execute FindText:=SearchPhrase, ReplaceWith:=ReplacePhrase, Replace:=wdReplaceAll 
         End With 
         'save and close the document (.docx) 
         Application.DisplayAlerts = False 
         ActiveDocument.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name 
         ActiveDocument.Close 
         Application.DisplayAlerts = True 
        End If 

        If MinExtensionX = "xlsx" Then 
         'open the document (.xlsx) 
         oExcel.Visible = True 
         Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name) 
         oWB.Activate 
         'replace all keyphrases sheet by sheet(.xslx) 
         For i = 1 To oWB.Sheets.Count 
          Sheets(i).Activate 
          ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False 
         Next i 
         'save and close the document (.xslx) 
         Application.DisplayAlerts = False 
         oWB.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name 
         oWB.Close 
         Application.DisplayAlerts = True 
        End If 

       End If 
      Next 
     Next 
    End If 
End With 

'close teh excel application and clean up 
oExcel.Quit 
Set oExcel = Nothing 

End Sub 

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) 
End Function 

Respuesta

2

El problema es con esta línea: Sheets(i).Activate Reemplazar con oWB.Sheets.Activate

Debido a otros problemas que encontrará, reescribí toda su sentencia if para archivos ".xlsx" con todas las referencias correctas. También he añadido comentarios largo aliento para explicar por qué lo cambié:

If MinExtensionX = "xlsx" Then 
    'open the document (.xlsx) 
    oExcel.Visible = True 
    Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name) 
    oWB.Activate 
    'replace all keyphrases sheet by sheet(.xslx) 
    For i = 1 To oWB.Sheets.Count 
     oWB.Sheets(i).Activate 'Must provide the workbook or Sheets() fails 
     oWB.ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False 'Must provide the workbook or tries to find activesheet in calling application. 
    Next i 
    'save and close the document (.xslx) 
    oExcel.DisplayAlerts = False 'Using Application instead of oExcel affects calling app instead of Excel 
    oWB.SaveAs Filename:=PathOfSelectedFolder & MyFile.Name 
    oWB.Close 
    oExcel.DisplayAlerts = True 'Using Application instead of oExcel affects calling app instead of Excel 
End If 
+0

Gracias Daniel! Esto es muy claro, y agradezco los consejos adicionales. Actualizaré mi código según sus sugerencias. – user1678035

0

esto podría no ser su problema específico, pero en mi caso lo ha sido en el pasado. El uso de Sheets ha demostrado causar muchos problemas cuando no necesita los otros tipos de hojas que contiene que Worksheets no contiene. Intente reemplazar todas las referencias Sheets con Worksheets.

Cuestiones relacionadas