Temas

[Sub FindAndReplaceFirstStoryOfEachType() Set objRegEx = CreateObject("vbscript.regexp") objRegEx.Global = True objRegEx.IgnoreCase = True objRegEx.MultiLine = True Set wdDoc = wdApp.Documents.Open("C:\Nueva carpeta\*.doc")With wdDoc.Content.Find .Text = "([1-31]{1,3})/([1-12]{1,3})/([2010-2016]{10,20})" .Replacement.Text = "<fecha actual>" .Wrap = wdFindContinue .Execute Replace:=wdReplaceAllEnd WithEnd Sub]

Hola de nuevo,
Hace poco pedí ayuda para un vbs  aquí y me lo solucionasteis muy rapido y bien, ahora otra vez ando con un problema parecido aunque esta vez es vba.
He estado mirando todo lo que he podido pero no he encontrado nada que me aclarase, si cosas parecidas pero no algo que me ayudara a acabarlo
Estoy intentando ver si puedo hacer un vba que reemplace la fecha de una cabecera por otra en varios documento .doc
El tema esta en que remplazara la fecha de la cabecera ( con este formato: 22/02/2014 ) por otra del mismo formato. La entrada de la fecha por la que se va a remplazar me da igual que este en el mismo script o que la pida al ejecutar.
Hasta ahora tengo hecho algo asi:
Sub FindAndReplaceFirstStoryOfEachType()
   Set objRegEx = CreateObject("vbscript.regexp")
   objRegEx.Global = True
   objRegEx.IgnoreCase = True
   objRegEx.MultiLine = True
   Set wdDoc = wdApp.Documents.Open("C:\Nueva carpeta\*.doc")
With wdDoc.Content.Find
     .Text = "([1-31]{1,3})/([1-12]{1,3})/([2010-2016]{10,20})"
     .Replacement.Text = "<fecha actual>"
     .Wrap = wdFindContinue
     .Execute Replace:=wdReplaceAll
End With
End Sub
He probado varias cosas y no doy con el formato adecuado en .Text para que me lo remplace y no consiguo que se aplique a la cabecera.
Espero que me podias ayudar tan bien como la ultima vez
Saludos

Buenas!
Os comento, para ser sincero nunca he programado en vbs hasta hace unos dias he tenido que hacer un vbs que me sacara el espacio libre de las particiones y que en caso de estar por debajo de 10GB lo mandase por correo
El caso es que mirando esto el tuto de esta pagina http://foro.elhacker.net/scripting/tutorial_vbscript-t229032.0.html y varias paginas mas consegui hacer uno que funcionase en mi pc correctamente, hasta ahi todo bien pero cuando pruebo en otro pc diferente sale error


El codigo es:

Código (vb) [Seleccionar] Expandir

Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMIService.ExecQuery ("Select * From Win32_Volume Where DriveType = 3")

For Each objItem In colItems
FSpace=objItem.FreeSpace
FSpace = (FSpace / 1024^3)
ispc2 = cDbl(objItem.FREESpace)


if FSpace < 10 Then
msg = "1"
texto = "La unidad: " & objItem.DriveLetter & " Tiene un espacio libre menor de 10GB, tiene un total de " & FormatiSpc(ispc2)  & " GB libres |  "
text = text & vbNewLine & texto
end if

Next

Function FormatiSpc(intSpace)
intSpace = intSpace/1024
intSpace = intSpace/1024
intSpace = intSpace/1024
intSpace= FormatNumber(intSpace,1)
FormatiSpc = intSpace
end Function



msg = strComputerName & vbNewLine & text
if msg <> "" then
sendMAIL(msg)
end if
Sub sendMAIL(msg)
Dim strbody
strbody = msg + chr(13) + chr(10)

set objcdo=createobject("cdo.message")
objcdo.subject="Espacio libre en particiones"
objcdo.from="kortiz@wisco.es"
objcdo.to="kortiz@wisco.es"
objcdo.textbody= strbody
objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.2.230"
objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
objcdo.configuration.fields.update
objcdo.send
End Sub

Seguro que habrá varias cosas mal pero yo no las veo, como ya digo soy un principiante en esto del vbs, el caso es que no veo que falla, en mi pc va perfecto y en el otro da eses error que es como si no guardase nada de colItem
Espero que me podais ayudar, he estado probando varias cosas y nada...
Saludos