Crear carpetas y almacenar doc en ellas access

Mi nombre es Marta, perdonar que moleste tengo una duda con este código:
Desde un botón creo una carpeta con el nombre de un campo para almacenar un documento de word, si la carpeta existe, solo me la abre si no la crea y me abre una plantilla de word para rellenar y guardarlo en esa carpeta que he creado.
Ahora mi problema es que a la hora de guardar el documento de word lo guarda en la misma dirección que la carpeta que he creado y no dentro de ella osea
si la carpeta que he creado es en c:\almacen\tareas\1 (1 es nombre de la carpeta)
EL ARCHIVO LO ALMACENA EN C:\ALMACEN\TAREAS\1.DOC (ES NOMBRE DEL ARCHIVO)
No encuentro la manera de almacenar el documento en su carpeta.
Te agradecería que me echaras una mano gracias de antemano.
Uso office 2003 osea que no puedo usar FileSystemObject
GRACIAS
Private Sub Comando88_Click()
On Error GoTo manejadorError
Dim appWord As Word.Application
Dim docs As Word.Documents
Dim doc As Word.Document
Dim campoWord As Object
Dim strRutaPlantilla As String
Dim strTestPlantilla As String
Dim strNuevoDocumento As String
Dim archivo
Dim strDirectorio
' Ruta completa de la plantilla de Word
strRutaPlantilla = "\\10.39.226.12\asuntos\tareas\PLANTILLAS\PLANTILLA1.doc"
' Ruta y nombre del nuevo documento
archivo = Dir("\\10.39.226.12\asuntos\tareas\ " & Me.N_Tarea, vbDirectory) ' directorio o carpeta a crear
strDirectorio = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea
If archivo = "" Then 'Si la carpeta no existe
MkDir ("\\10.39.226.12\asuntos\tareas\ " & Me.N_Tarea) ' se crea la carpeta
Else
MsgBox "LA CARPETA YA EXISTE"
carpeta = "\\10.39.226.12\asuntos\tareas\ " & Me.N_Tarea
Shell "explorer.exe " & carpeta, vbNormalFocus 'si existe se abre
Exit Sub
End If
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & ".doc"
'strNuevoDocumento = strDirectorio & "\" & Me.N_Tarea & ".doc"
Set appWord = CreateObject(Class:="Word.Application")
Set docs = appWord.Documents
Set doc = docs.Add(strRutaPlantilla)
With appWord
.Visible = True
.ActiveDocument.SaveAs strNuevoDocumento
.Activate
End With
manejadorErrorSalir:
Exit Sub
manejadorError:
If Err.Number = 429 Then
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Else
MsgBox Err.Description, , "Error Nº: " & Err.Number
Resume manejadorErrorSalir
End If
End Sub

3 respuestas

Respuesta
1
El problema que tienes es que defines una ruta incorrecta del nuevo archivo de word. Además no sé si tienes activada la "option exclicit" (requerir la declaración de variables) pero, si la tienes, el código que me pasas tiene que darte algún que otro error.
Dicho esto te explico cómo debes arreglar tu código:
1.- En la declaración de variables debes añadir una variable que utilizas en el código pero que no tienes definida. Así, en todas las DIM del principio, añades:
Dim carpeta As String
2.- Tienes una línea perdida ahí, que es:
strDirectorio = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea
Simplemente cámbiala por
carpeta = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea
3.- Y en la línea que pone:
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & ".doc"
Escribes
strNuevoDocumento = carpeta & "\" & Me.N_Tarea & ".doc"
---
Te escribo de nuevo todo el código (te he marcado en negrita los cambios, y te he quitado las líneas de código que sobraban) por si hay alguna duda oculta por ahí... ;)
---
Private Sub Comando88_Click()
On Error GoTo manejadorError
Dim appWord As Word.Application
Dim docs As Word.Documents
Dim doc As Word.Document
Dim campoWord As Object
Dim strRutaPlantilla As String
Dim strTestPlantilla As String
Dim strNuevoDocumento As String
Dim carpeta As String
Dim archivo
Dim strDirectorio
' Ruta completa de la plantilla de Word
strRutaPlantilla = "\\10.39.226.12\asuntos\tareas\PLANTILLAS\PLANTILLA1.doc"
' Ruta y nombre del nuevo documento
archivo = Dir("\\10.39.226.12\asuntos\tareas\ " & Me.N_Tarea, vbDirectory) ' directorio o carpeta a crear
carpeta = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea
If archivo = "" Then 'Si la carpeta no existe
MkDir ("\\10.39.226.12\asuntos\tareas\ " & Me.N_Tarea) ' se crea la carpeta
Else
MsgBox "LA CARPETA YA EXISTE"
Shell "explorer.exe " & carpeta, vbNormalFocus 'si existe se abre
Exit Sub
End If
strNuevoDocumento = carpeta & "\" & Me.N_Tarea & ".doc"
Set appWord = CreateObject(Class:="Word.Application")
Set docs = appWord.Documents
Set doc = docs.Add(strRutaPlantilla)
With appWord
.Visible = True
.ActiveDocument.SaveAs strNuevoDocumento
.Activate
End With
manejadorErrorSalir:
Exit Sub
manejadorError:
If Err.Number = 429 Then
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Else
MsgBox Err.Description, , "Error Nº: " & Err.Number
Resume manejadorErrorSalir
End If
End Sub
---
Ya me dirás qué tal
Un saludo,
https://www.sugarsync.com/pf/D274241_64_9569447084 ... http://neckkito.eu5.org ...
Se me olvidaba comentarte que para poder emplear el FileSystemObject necesitas registrar una biblioteca. Te explico cómo se hace eso:
- Abres el VBE (editor de visual basic) y te vas al menú Herramientas->Referencias...
- Ahí buscas una biblioteca llamada "Microsoft Scripting Runtime". Marcas el check y aceptas.
Con eso ya la tendrás registrada y podrás utilizar fso.
Si por casualidad no la tuvieras tienes que buscar el archivo, en tu PC, llamado scrrun.dll. Para registrarlo debes hacer lo mismo que te he explicado pero ir a través del botón "Examinar..."
Un saludo.
https://www.sugarsync.com/pf/D274241_64_9569447084... http://neckkito.eu5.org ...
Muchísimas gracias me has servido mucho de ayuda, al final el código queda así:
Creo la carpeta si no existe
Dim CARPETA
Dim RutaCarpeta As String
RutaCarpeta = "\\10.39.226.12\asuntos\tareas\" & Me.Asunto
If Me.Asunto <> "" Then
If Dir(RutaCarpeta, vbDirectory) = "" Then
MsgBox "LA CARPETA NO EXISTE Y SE CREARÁ", 16
Set CARPETA = CreateObject("scripting.filesystemobject")
CARPETA.CreateFolder (RutaCarpeta)
End If
Else
MsgBox "INTRUDUCE NÚMERO DE ASUNTO"
Exit Sub
End If
Shell "explorer.exe " & RutaCarpeta, vbNormalFocus 'si existe se abre
Y DESPUÉS ABRO LA PLANTILLA Y LA GUARDO ASÍ, SI NO EXISTE LA CARPETA ME PIDE QUE HAGA:

Dim appWord As WORD.Application
Dim docs As WORD.Documents
Dim doc As WORD.Document
Dim campoWord As Object
Dim strRutaPlantilla As String
Dim strTestPlantilla As String
Dim strNuevoDocumento As String
Dim archivo
Dim CARPETA
Dim RutaCarpeta As String
' Ruta completa de la plantilla de Word
strRutaPlantilla = "\\10.39.226.12\asuntos\tareas\PLANTILLAS\ActaEntrega.dot"
' Ruta y nombre del nuevo documento
archivo = Dir("\\10.39.226.12\asuntos\tareas\" & Me.Asunto, vbDirectory) ' directorio o carpeta a crear
RutaCarpeta = "\\10.39.226.12\asuntos\tareas\" & Me.Asunto
If Me.Asunto <> "" Then
If Dir(RutaCarpeta, vbDirectory) = "" Then
MsgBox "LA CARPETA NO EXISTE Y SE CREARÁ", 16
Set CARPETA = CreateObject("scripting.filesystemobject")
CARPETA.CreateFolder (RutaCarpeta)
End If
strNuevoDocumento = RutaCarpeta & "\" & Me.N_Tarea & "ACTA" & ".doc"
Set appWord = CreateObject(Class:="Word.Application")
Set docs = appWord.Documents
Set doc = docs.Add(strRutaPlantilla)
With appWord
.Visible = True
.ActiveDocument.SaveAs strNuevoDocumento
.Activate
End With
Else
MsgBox "INTRUDUCE NÚMERO DE ASUNTO"
Exit Sub
End If
Esto me funciona pero sería mejor guardar el documento con el nombre que yo quiera darle y en la carpeta que he creado... así no lo sobreescribiría...
¿Alguna sugerencia? Muchas gracias llevo 1 mes para intentar hacer esto y me estoy volviendo loca...
Puedes asignarle el nombre a través de un InputBox, si quieres, y después pasar el nombre a través de la variable que guarda el valor del inputbox.
Por ejemplo, justo antes de la línea que pones:
strNuevoDocumento = RutaCarpeta & "\" & Me.N_Tarea & "ACTA" & ".doc"
Escribes lo siguiente:
---
Dim miNombre as Variant
miNombre=InputBox("Nombre del documento","NOMBRE","ACTA")
If miNombre="" then
miNombre="ACTA"
End If
---
Y esa línea que te comentaba la escribes de la siguiente manera:
strNuevoDocumento = RutaCarpeta & "\" & Me.N_Tarea & miNombre & ".doc"
Como verás, es necesario que la variable mi nombre tenga algún valor para que el código no te salte, y antes que salir del proceso (y dejarlo a medias) el menor de los males es que te sobrescriba el nombre de archivo.
Ya me dirás ;)
Suerte!
https://www.sugarsync.com/pf/D274241_64_9569447084... http://neckkito.eu5.org ...
No he recibido noticias tuyas. Te rogaría que cerraras la consulta.
Respuesta
1
Sin entrar a valorar el código, ya que dices que te funciona, para que darle vueltas. Prueba cambiando esta linea:
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & ".doc"
Por
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & " & "\" & " & Me.N_Tarea & ".doc"
Me cuentas.
Respuesta
1
El problema que veo es en estas líneas:
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & ".doc"
ActiveDocument. SaveAs strNuevoDocumento
¿Según entiendo lo que quieres es que en la carpeta 1 se guardará un archivo 1.doc no?
Intenta con
strNuevoDocumento = "\\10.39.226.12\asuntos\tareas\" & Me.N_Tarea & "\" &
Me.N_Tarea &".doc"
¿Según entiendo lo que quieres es que en la carpeta 1 se guardará un archivo 1.doc no?
Muchísimas has entendido bien, pero casi prefiero guardar el documento con el nombre que yo quiera darle y en la carpeta que he creado, así me permite guardar más de un documento en esa carpeta, gracias me has servido mucho de ayuda, de momento el código queda así:
Creo la carpeta si no existe
Dim CARPETA
Dim RutaCarpeta As String
RutaCarpeta = "\\10.39.226.12\asuntos\tareas\" & Me.Asunto
If Me.Asunto <> "" Then
If Dir(RutaCarpeta, vbDirectory) = "" Then
MsgBox "LA CARPETA NO EXISTE Y SE CREARÁ", 16
Set CARPETA = CreateObject("scripting.filesystemobject")
CARPETA.CreateFolder (RutaCarpeta)
End If
Else
MsgBox "INTRUDUCE NÚMERO DE ASUNTO"
Exit Sub
End If
Shell "explorer.exe " & RutaCarpeta, vbNormalFocus 'si existe se abre
Y después abro la plantilla y la guardo así, si no existe la carpeta me pide que haga:
Dim appWord As WORD.Application
Dim docs As WORD.Documents
Dim doc As WORD.Document
Dim campoWord As Object
Dim strRutaPlantilla As String
Dim strTestPlantilla As String
Dim strNuevoDocumento As String
Dim archivo
Dim CARPETA
Dim RutaCarpeta As String
' Ruta completa de la plantilla de Word
strRutaPlantilla = "\\10.39.226.12\asuntos\tareas\PLANTILLAS\ActaEntrega.dot"
' Ruta y nombre del nuevo documento
archivo = Dir("\\10.39.226.12\asuntos\tareas\" & Me.Asunto, vbDirectory) ' directorio o carpeta a crear
RutaCarpeta = "\\10.39.226.12\asuntos\tareas\" & Me.Asunto
If Me.Asunto <> "" Then
If Dir(RutaCarpeta, vbDirectory) = "" Then
MsgBox "LA CARPETA NO EXISTE Y SE CREARÁ", 16
Set CARPETA = CreateObject("scripting.filesystemobject")
CARPETA.CreateFolder (RutaCarpeta)
End If
strNuevoDocumento = RutaCarpeta & "\" & Me.N_Tarea & "ACTA" & ".doc"
Set appWord = CreateObject(Class:="Word.Application")
Set docs = appWord.Documents
Set doc = docs.Add(strRutaPlantilla)
With appWord
.Visible = True
.ActiveDocument.SaveAs strNuevoDocumento
.Activate
End With
Else
MsgBox "INTRUDUCE NÚMERO DE ASUNTO"
Exit Sub
End If
Esto me funciona pero sería mejor guardar el documento con el nombre que yo quiera darle y en la carpeta que he creado... así no lo sobreescribiría...
¿Alguna sugerencia? Muchas gracias llevo 1 mes para intentar hacer esto y me estoy volviendo loca...
Perdona no contestarte antes y si bien entiendo lo que quieres hacer, por falta de tiempo no puedo seguir analizando tu código, se me han juntado las preguntas, por lo tanto te paso el código que encontré por ahí y que he manejado desde hace mucho que me ha servido perfecto, te crea la carpeta, si ya existe ya no hace nada, se conecta a la plantilla y como la plantilla tiene previamente marcadores donde quieres que se transfieran los campos del formulario te queda perfecto, adicionalmente guardas el archivo con un nuevo combre para liberar la plantilla y dejarla intacta bueno te paso el código analízalo y me comentas que tal saludos
Private Sub Comando16_Click()
'---------- DIRECTORIO ---------------
El_Path = "\\10.39.226.12\asuntos\tareas\" & Me.Asunto
Array_Dir = Split(El_Path, "\")
El_Path = vbNullString
'Recorre el array anterior para ir creando uno por uno
For i = LBound(Array_Dir) To UBound(Array_Dir)
Sub_Dir = Array_Dir(i)
If Len(Sub_Dir) > 0 Then
El_Path = El_Path & Sub_Dir & "\"
If Right$(Sub_Dir, 1) <> ":" Then
'Verificamos que no exista
If Dir$(El_Path, vbDirectory) = vbNullString Then
'Crea la carpeta
Call MkDir(El_Path)
End If
End If
End If
Next i
'-----------------------------------------------
'-----------------------------------------------
Set Worda = CreateObject("word.application")
Documento1 = "\\10.39.226.12\asuntos\tareas\PLANTILLAS\ActaEntrega.dot"
Worda.Documents.Open (Documento1)
With Worda
.Documents.Item(1).Bookmarks.Item("clave").Range.Text = ClaveACU 'donde clave es el nombre del marcador en word y claveACU es el nombre del campo del formulario
.Documents.Item(1).SaveAs ("\\10.39.226.12\asuntos\tareas\" & Me.Asunto & "\" & Me.N_Tarea & "ACTA" & ".doc")
End With
Set Worda = Nothing
MsgBox "Operación Realizada con éxito", vbInformation, "OK"
Application.FollowHyperlink "\\10.39.226.12\asuntos\tareas\" & Me.Asunto & "\" & Me.N_Tarea & "ACTA" & ".doc"
End Sub
He tratado de modificarlo según tu ejemplo
Muchas gracias por todo, imagino que estarás liado con todas las preguntas que te llega... Probaré lo que me diste. Muchas gracias y un saludo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Los procesos de Word

Y voy a ir directo al grano. Cuando utilizo un objeto de Word desde visual basic, me arraca un proceso, el cual siempre se queda abierto y no se como cerrarlo. Si sabes como o puedes decirme algo relacionado con el tema te estaría my agradecido
2 respuestas

A vueltas conel formulario de access al vincularlo

El formulario es uno creado en access normal, y al querer vincularlo introduzco código de vb, se abre el documento en word (si bien es cierto que no me rellena los campos marcados...)y en el formulario de access me da un error "5941 el elemento del...
1 respuesta

Vb6 y word

Quiero con mi programa de vb6.0 arrancar una plantilla que tengo en microsoft word para rellenar los campos que yo quiera. He usado la correspondencia que lo he encontrado en internet, pero cuando ya voy a ejecutarlo con mi programa visual basic te...
1 respuesta

Datos de Access a formulario (macro) en Word.

Tengo un pequeño programita (macro) en Word con visual basic, con el abro una pantalla ingreso un rut y con ese rut me gustaría consultar una base de datos access para devolver ciertos campos de una tabla. Por ejemplo dato el rut que me devuelva el...
1 respuesta

Crear carpeta

Como puedo crear una carpeta y que tenga el nombre que le ponga en un textbox y que me pregunte si existe y si no existe crearla
2 respuestas

Abrir y llamar macros

¿Cómo hago una macro que mande llamar un archivo especifico el cual contiene un formato a llenar y valide si existe o no? Nota: estoy desesperado y llevo una semana con el problema.
1 respuesta

Formulario que me muestre word en visual basic 6.0

Tengo un problema y megustaria que me ayudaras. Consiste en crear un formulario que me permita escribir un texto(textbox)y luego un boton de comando que me permitira ver dicho texto en word.
1 respuesta

Error automatización word.

Tengo el siguiente código: Private Sub cmdDoc_Click() Dim strGrabaRef As String 'REM strGrabaRef = Me.txtRef & ".doc" strGrabaRef = "UE 02 016.doc" '_________________________________________________________________ 'Grabamos la refencia en el la...
1 respuesta

Macro excel para cerrar word

Lo que pretendo es crear una macro en Excel que me abra una deteterminada página word para imprimirla (explicado a groso modo), el problema es que no consigo crearla para que funcione de forma eficiente ya que por un lado al abrir el word tengo que...
2 respuestas

Tablas insertadas con Word

Soy usuario de Visual Basic 6 desde hace un año. Tengo problemas a la hora de entender el mecanismo de OLE Automatización entre otras cosas porque no lo tengo documentado a pesar de tener varios libros de VB 6, uno muy bueno de 1200 págs. Pero donde...
1 respuesta