Am facut urmatoarele doua coduri care ce fac?
Cauta in folderul sPath daca exista fisiere .doc, daca exista atunci cauta in strNumeFisierExistent daca exista acest fisier aici, daca da atunci inchide documentul activ daca nu atunci ruleaza un mesaj sau o alta procedura.
Problema este ca primul fisier il duce la capat iar cand vrea sa fac acelasi lucru cu urmatoarele imi apare acest mesaj de eroare atasat.
Cod: Selectaţi tot
Option Explicit
Dim fso
Dim Ci As Long
Dim strRezDirPath As String
Dim msg As String
Dim strANRezDirPath As String
Dim strLunaRezDirPath As String
Dim strZiRezDirPath As String
Dim strNumeFisierActivPath As String
Dim strNumeFisierExistent As String
Dim path12 As String
Dim path1 As String
Dim path2 As String
Dim path3 As String
Dim path4 As String
Dim path5 As String
Dim path6 As String
Dim DataIns As String
Dim DataInsLuna As String
Dim DataInsZi As String
Dim DataInsNumFisier As String
Dim sFil As String
Dim w As Integer
Const NumeFisier1 As String = "decizie.docx"
Const NumeFisier2 As String = "sentinta.docx"
Const NumeFisier3 As String = "comunicare.docx"
Const NumeFisier4 As String = "citatie.docx"
Const NumeFisier5 As String = "notificare.docx"
Const NumeFisier6 As String = "convocare.docx"
Dim sPath As String
Const strDirPath As String = "C:\Users\Costi\Desktop\Prelucrate\"
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CautaDeschideFisier()
'aceste linii de comanda cauta in sPath daca exista fisiere ce trebuiesc prelucrate
'On Error GoTo eroare
'''Application.ScreenUpdating = False
Application.DisplayAlerts = False
'opening every time a file is opened and closed.
Ci = 0 'initial value for Ci
sPath = "C:\Users\Costi\Desktop\bpi\" 'here's where to look for
ChDrive "C" 'change drive to whatever has been specified above and by user input - look in here, and only in here!
ChDir sPath 'same as above, change directory to look here and only here (probably unecessary)
sFil = Dir("*.doc?") 'open all .doc and .docx files in this directory
If sFil <> "" Then
Do While sFil <> "" 'loop through the following while the file name is not nothing, i.e. for all files in the directory
Documents.Open FileName:=sPath & sFil 'actual command to open each file
Call TipDoc
'MsgBox "gata"
'ActiveDocument.Close
sFil = Dir 'continue to keep looking in the specified directory, as above
Ci = Ci + 1 'when the next paste occurs, put it in column Ci+1, i.e. Row 4:Column 3, then Row 4:Column 4...etc
' Call TipDoc
Loop
Else
MsgBox "Nu exista nici un fisier in vederea prelucrarii."
End If
'Application.ScreenUpdating = True
Application.DisplayAlerts = True
'For w = 1 To Ci
' Call TipDoc
'Next
'eroare:
' Exit Function
End Sub
Public Function TipDoc()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DataIns = Format(Date, "yyyy")
DataInsLuna = Format(Date, "mmmm")
DataInsZi = Format(Date, "ddmmyyyy")
DataInsNumFisier = ActiveDocument.Name
'creaza in directorul principal directorul AN iar in acest director creaza un alt director ce are numele lunii curente
strANRezDirPath = strDirPath & DataIns & "\"
strLunaRezDirPath = strANRezDirPath & DataInsLuna & "\"
strZiRezDirPath = strLunaRezDirPath & DataInsZi & "\"
strNumeFisierActivPath = strZiRezDirPath & DataInsNumFisier & "\"
strNumeFisierExistent = strNumeFisierActivPath & DataInsNumFisier
''''''''''''''''''''''''''''''''''''''
'cauta folderul care sa aiba numele fisierului activ
If Dir(strNumeFisierActivPath, vbDirectory) <> "" Then
strRezDirPath = strNumeFisierActivPath
MsgBox ("Acest Director " + Chr(13) + strRezDirPath + Chr(13) + " exista.")
Else
'MsgBox ("Acest Director " + strRezDirPath + " nu exista.")
Application.Run MacroName:="DirExist_create_path"
Application.Run MacroName:="DirExist_createPath_Luna"
Application.Run MacroName:="DirExist_createPath_Zi"
Application.Run MacroName:="dir_name_fisier"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
'Set fso = CreateObject("Word.Application")
path12 = fso.GetAbsolutePathName(strNumeFisierExistent)
path1 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier1)
path2 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier2)
path3 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier3)
path4 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier4)
path5 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier5)
path6 = fso.GetAbsolutePathName(strNumeFisierActivPath & NumeFisier6)
If (fso.FileExists(path12)) Then
'If (fso.FileExists(strNumeFisierExistent)) Then
'msg = MsgBox("Fisierul: " + Chr(13) + DataInsNumFisier & vbCr & " a fost salvat, verifica editarea.")
'ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + DataInsNumFisier + " nu exista.")
Application.Run MacroName:="Save_name_fisier"
End If
If (fso.FileExists(path1)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier1 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier1 + " nu exista.")
If (fso.FileExists(path2)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier2 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier2 + " nu exista.")
If (fso.FileExists(path3)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier3 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier3 + " nu exista.")
If (fso.FileExists(path4)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier4 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier4 + " nu exista.")
If (fso.FileExists(path5)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier5 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier5 + " nu exista.")
If (fso.FileExists(path6)) Then
msg = MsgBox("Fisierul: " + Chr(13) + NumeFisier6 & vbCr & " a fost salvat, verifica editarea.")
ActiveDocument.Close
Else
'MsgBox ("Acest Fisier: " + NumeFisier6 + " nu exista.")
Sleep 200
Application.Run MacroName:="TipFisier"
'ActiveDocument.Close
End If
End If
End If
End If
End If
End If
End Function
si mai am o problema.
Cum fac sa ruleze mai rapid in special macroul CautaDeschideFisier.
Va multumesc
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.