Merhaba
Bazı nedenlerden dolayı çalıştığım dosya için bir yedekleme eklentisi hazırlamaya çalıştım. Ve aşağıdaki makro ortaya çıktı. Bu makronun kodunda/çalışmasında herhangi bir problem yok, hatta beklediğimden hızlı çalıştığı için yedekleme aralığını 1dk.ya çektim. Fakat bir süre sonra makro kendini tetikleyemeyerek duruyor(koddaki son satır). Makro bazen 10dk.da duruyor, bazende 1-2 saat stabil çalışıyor. Bu sorunun makroyla ilgili olduğunu düşünmesemde buradaki ustaların gözüne ne takılır bilinmez. Bu yüzden ilgili kodu değiştirmeden sadece bazı yerlerine XXXX yazarak kopyaladım.
Buna benzer bir sorunla karşılaşan yada eklentinin zamanlı çalışmasını daha değişik yöntemlerle çözen arkadaşların önerilerini paylaşmasını rica ediyorum. Teşekkürler..
Sub kayit()
Dim i, y As Integer
Dim sayac As String
On Error GoTo son
If AddIns("verikurtarma").Installed = False Then GoTo son
sayac = Dir(Mid(ThisWorkbook.Path, 1, Len(ThisWorkbook.Path) - 5) & "\XXXX\" & "XXXX-*.txt")
If sayac = "" Then GoTo son
sayac = Mid(sayac, 6, Len(sayac))
sayac = Mid(sayac, 1, Len(sayac) - 4) & ".xls"
If Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) = 0 Then GoTo son
Open Mid(ThisWorkbook.Path, 1, Len(ThisWorkbook.Path) - 6) & "\XXXX\XXXX\" & Mid(Time, 1, 2) & "." & Mid(Time, 4, 2) & "." & Mid(Time, 7, 2) & "-" & Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) & "-" & Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) & "-" & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yyyy") & ".txt" For Output As #1
For y = 1 To 3
With Workbooks(sayac).Sheets
For i = 1 To WorksheetFunction.CountA(.Range("A3:A402"))
DoEvents
Print #1, .Cells(i + 2, 2) & "*" & .Cells(i + 2, 3) & "*" & .Cells(i + 2, 4) & "*" & .Cells(i + 2, 5) & "*" & .Cells(i + 2, 6) & "*" & .Cells(i + 2, 7) & "*" & .Cells(i + 2, 9) & "*" & .Cells(i + 2, 10) & "*" & .Cells(i + 2, 14) & "*" & .Cells(i + 2, 16)
Next i
End With
Next y
Close #1
son:
Application.OnTime Now + TimeValue("00:01:00"), "kayit"
End Sub
Bazı nedenlerden dolayı çalıştığım dosya için bir yedekleme eklentisi hazırlamaya çalıştım. Ve aşağıdaki makro ortaya çıktı. Bu makronun kodunda/çalışmasında herhangi bir problem yok, hatta beklediğimden hızlı çalıştığı için yedekleme aralığını 1dk.ya çektim. Fakat bir süre sonra makro kendini tetikleyemeyerek duruyor(koddaki son satır). Makro bazen 10dk.da duruyor, bazende 1-2 saat stabil çalışıyor. Bu sorunun makroyla ilgili olduğunu düşünmesemde buradaki ustaların gözüne ne takılır bilinmez. Bu yüzden ilgili kodu değiştirmeden sadece bazı yerlerine XXXX yazarak kopyaladım.
Buna benzer bir sorunla karşılaşan yada eklentinin zamanlı çalışmasını daha değişik yöntemlerle çözen arkadaşların önerilerini paylaşmasını rica ediyorum. Teşekkürler..
Sub kayit()
Dim i, y As Integer
Dim sayac As String
On Error GoTo son
If AddIns("verikurtarma").Installed = False Then GoTo son
sayac = Dir(Mid(ThisWorkbook.Path, 1, Len(ThisWorkbook.Path) - 5) & "\XXXX\" & "XXXX-*.txt")
If sayac = "" Then GoTo son
sayac = Mid(sayac, 6, Len(sayac))
sayac = Mid(sayac, 1, Len(sayac) - 4) & ".xls"
If Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) = 0 Then GoTo son
Open Mid(ThisWorkbook.Path, 1, Len(ThisWorkbook.Path) - 6) & "\XXXX\XXXX\" & Mid(Time, 1, 2) & "." & Mid(Time, 4, 2) & "." & Mid(Time, 7, 2) & "-" & Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) & "-" & Workbooks(sayac).Sheets("XXXX").Range("B" & WorksheetFunction.Match("XXXX", Workbooks(sayac).Sheets("XXXX").Range("A:A"), 0)) & "-" & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yyyy") & ".txt" For Output As #1
For y = 1 To 3
With Workbooks(sayac).Sheets
For i = 1 To WorksheetFunction.CountA(.Range("A3:A402"))
DoEvents
Print #1, .Cells(i + 2, 2) & "*" & .Cells(i + 2, 3) & "*" & .Cells(i + 2, 4) & "*" & .Cells(i + 2, 5) & "*" & .Cells(i + 2, 6) & "*" & .Cells(i + 2, 7) & "*" & .Cells(i + 2, 9) & "*" & .Cells(i + 2, 10) & "*" & .Cells(i + 2, 14) & "*" & .Cells(i + 2, 16)
Next i
End With
Next y
Close #1
son:
Application.OnTime Now + TimeValue("00:01:00"), "kayit"
End Sub