Merge pull request #9 from reynerth/patch-1

Update DBVMacrosTodas.bas

Utilidades/DBVMacrosTodas.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "DBVMacros"
 Option Explicit
 ' Autor: David Bueno Vallejo
 ' twitter: @davidbuenov  linkedin: davidbueno
@@ -23,9 +22,21 @@ Public Sub DividirDocumento()
     Dim seccion As Section
     Dim carpeta As String
     Dim numSeccion As Integer
+    Dim carpetaBase As String    '/// nueva variable para almacenar la ruta inicial original
 
     'carpeta = "d:\temp\generados"  'si queremos marcar ruta especifica
-    carpeta = ActiveDocument.Path 'si queremos que se guarde en la misma carpeta
+    ' ///
+    carpeta = ActiveDocument.Path & "\Documento Dividido"
+    carpetaBase = ActiveDocument.Path
+    ' Comprueba si la carpeta ya existe
+    If Dir(carpeta, vbDirectory) = "" Then
+        ' Crea la carpeta si no existe
+        MkDir carpeta
+    Else
+        ' La carpeta ya existe
+    End If
+    ' ///
+
     On Error GoTo ControlErrores
     docPrincipal = ActiveDocument.Name
     nombreDocs = Mid(docPrincipal, 1, Len(docPrincipal) - 4) 'quita al nombre del documento la extension. Quedaria Todosv4.
@@ -38,9 +49,10 @@ Public Sub DividirDocumento()
         EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
         :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
     'Al guardarlo como el documento original .docx se cierra. Asi lo abrimos de nuevo
-    Documents.Open (carpeta & "\" & docPrincipal)
+    '/// Al abrir el dpcumento original utilizar la ruta inicial en carpetabase, pues la ruta actual corresponde a la subcarpeta
+    Documents.Open (carpetaBase & "\" & docPrincipal)
     Documents(docPrincipal).Activate
-    Documents(carpeta & "\" & nombreDocs & "dotx").Close
+    Documents(carpeta & "\" & nombreDocs & "dotx").Close SaveChanges:=wdSaveChanges
 
     ' Recorre todas las secciones ignorando el ultimo salto de seccion
     For numSeccion = 1 To Documents(docPrincipal).Sections.Count - 1
@@ -60,7 +72,7 @@ Public Sub DividirDocumento()
         End With
     Next numSeccion
     If numSeccion - 1 = 0 Then
-        MsgBox "DBV. Recuerda que al final del documento debes insertar un salto de sección"
+        MsgBox "DBV. Recuerda que al final del documento debes insertar un salto de sección"
     Else
         MsgBox "Se han generado: " & numSeccion - 1 & " documentos"
     End If
@@ -90,9 +102,23 @@ Public Sub GuardarSeleccion()
     Dim nuevoDoc As Document
     Dim nombreDoc As String
     Dim carpeta As String
+    Dim carpetaBase As String    '/// nueva variable para almacenar la ruta inicial original
 
     'carpeta = "d:\temp\generados"  'si queremos marcar ruta especifica
-    carpeta = ActiveDocument.Path 'si queremos que se guarde en la misma carpeta
+    ' Nombre de la carpeta a crear
+    ' /// Cambio Propuesto, hacer que se guarden los documentos en una subcarpeta segun eñ tipo de acción, de modo que los archivos generados por estas acciones no se mezclen con los archivos originales
+    carpeta = ActiveDocument.Path & "\Secciones Guardadas"
+    carpetaBase = ActiveDocument.Path
+
+    ' Comprueba si la carpeta ya existe
+    If Dir(carpeta, vbDirectory) = "" Then
+        ' Crea la carpeta si no existe
+        MkDir carpeta
+    Else
+        ' La carpeta ya existe
+    End If
+    ' ///
+
     docPrincipal = ActiveDocument.Name
     On Error GoTo ControlErrores
     'quita al nombre del documento la extension. Quedaria Todosv4.
@@ -101,16 +127,17 @@ Public Sub GuardarSeleccion()
     Selection.Copy
 
     ' hay que guardar el documento original como plantilla para asociarsela al nuevo documento
-    ActiveDocument.SaveAs2 FileName:=carpeta & "\" & nombreDocs & "dotx", _
+    ActiveDocument.SaveAs2 FileName:=carpeta & "\Secciones Guardadas\" & nombreDocs & "dotx", _
         FileFormat:=wdFormatXMLTemplate, LockComments:=False, _
         AddToRecentFiles:=False, ReadOnlyRecommended:=False, _
         EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
         :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
     'Al guardarlo como el documento original .docx se cierra. Asi lo abrimos de nuevo
-    Documents.Open (carpeta & "\" & docPrincipal)
+    '/// Al abrir el dpcumento original utilizar la ruta inicial en carpetabase, pues la ruta actual corresponde a la subcarpeta
+    Documents.Open (carpetaBase & "\" & docPrincipal)
     Documents(docPrincipal).Activate
-    Documents(carpeta & "\" & nombreDocs & "dotx").Close
-    
+    Documents(carpetaBase & "\" & nombreDocs & "dotx").Close SaveChanges:=wdSaveChanges
+
     ' Creamos el documento
     Set nuevoDoc = Documents.Add
 
@@ -131,9 +158,8 @@ ControlErrores:
      Select Case Err.Number
         Case 4605
             mensaje = "EDBV. Pero que quiere que guarde si no has seleccionado nada :-)"
-
         Case Else
             mensaje = "EDBV. Se ha producido el error: " & Err.Number & " - " & Err.Description
     End Select
     MsgBox mensaje
-End Sub
+End Sub