Excel.deki verileri XML olarak kaydetmek

[İsmail Küçükşengün]

Merhabalar;

Sub XML_Hazirla()
Dim xmlStr As String
Dim TAB1 As String
 
TAB1 = Chr$(9)
'On Error Resume Next
hata_yok = True
 
If hata_yok Then
 
   Open ActiveSheet.Range("J3").Value For Output As #1
   If Err <> O Then
       MsgBox ("Verilen Dosya Adı Hatalı. (Örnek: d:\Takip_Talebi_1.xml)")
       Exit Sub
   End If
   xmlStr = "<?xml version=""1.0"" encoding=""UTF-8""?>"
……………
…………………………

Koduyla excel sayfasındaki verileri D: Sürücüsünde " Takip Talebi-1" olarak ve XML belgesi olarak kaydediyorum.

Sorunum şu:

Şayet D sürücüsünde önceden aynı adlı XML belgesi varsa, yenisi aynı belge ile değişiyor.

Bunun yerine şayet D Sürücüsünde "Takip Talebi-1" adlı XML belgesi varsa
Open ActiveSheet.Range("J3").Value For Output As #1
kod satırından sonra yeni belgenin " Takip Talebi-2" 2 varsa 3 ...... şeklinde isim alması için nasıl bir ilave gerekir.

İlginiz ve yardımlarınız için şimdiden teşekkürler.

 

[Haluk]

D:\TestFolder isimli klasör altındaki Takip_Talebi_1.xml ..... gibi dosyalar üzerinde çalışmak üzere;

Sub Test()
    Dim FSO As Object, MyFolder As Object, MyFile As Object
    Dim MaxN As Long
    Dim Temp
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFolder = FSO.GetFolder("[B][COLOR=red]D:\TestFolder[/COLOR][/B]")
    MaxN = 0
    For Each MyFile In MyFolder.Files
        If LCase(Right(MyFile.Name, 3)) = "xml" Then
            Temp = Replace(MyFile.Name, "Takip_Talebi_", Empty)
            Temp = Val(Replace(Temp, ".xml", Empty))
            If Val(Temp) > MaxN Then MaxN = Val(Temp)
        End If
    Next
        MsgBox "Rastlanan en son dosya :" & "Takip_Talebi_" & MaxN & " .xml" _
              & vbCrLf & vbCrLf & "Yeni dosya adi : Takip_Talebi_" & MaxN + 1 & ".xml"
    Set MyFolder = Nothing
    Set FSO = Nothing
End Sub

 

[İsmail Küçükşengün]

Sayın Haluk Üstadım;

Verdiğiniz kodu Modüle yerleştirdim.

D sürücüsünde de Test Folder isimli klasör açtım. Fakat 2 adet XML. dosyası yaratılıyor. 3. ve 4.... yaratılamıyor. Acaba nerede eksikliğim var?

Ekte gönderdiğim örnek dosyama bakabilirseniz çok hayra geçecek.

Selam ve saygılarımla.

 

[veyselemre]

@Haluk Bey'in kodlarına kırmızı satırı ekleyin.

Sub Test()
..
..
Set FSO = Nothing
ActiveSheet.Range("J3").Value = "D:\TestFolder\Takip_Talebi_" & MaxN + 1 & ".xml"
End Sub

 

[İsmail Küçükşengün]

Sayın Veyselemre;

Tek kelime ile harikasınız. Çok teşekkür ediyorum.

Sayın Haluk Üstadıma da en içten teşekkürler.

 

[İsmail Küçükşengün]

Sayın Haluk ve Veyselemre’nin yardımıyla;
Kod:

Sub Test() Dim FSO As Object, MyFolder As Object, MyFile As Object Dim MaxN As Long Dim Temp Set FSO = CreateObject("Scripting.FileSystemObject") Set MyFolder = FSO.GetFolder("D:\Hukuk\UYAPDOSYALARI") MaxN = 0 For Each MyFile In MyFolder.Files If LCase(Right(MyFile.Name, 3)) = "xml" Then Temp = Replace(MyFile.Name, "Takip_Talebi_", Empty) Temp = Val(Replace(Temp, ".xml", Empty)) If Val(Temp) > MaxN Then MaxN = Val(Temp) End If Next MsgBox "D Sürücüsü/Hukuk/UYAP DOSYALARI Klasöründe Rastlanan en son uyap dosyası :" & "Takip_Talebi_" & MaxN & " .xml" _ & vbCrLf & vbCrLf & "Yeni dosya adı : Takip_Talebi_" & MaxN + 1 & ".xml", vbOKOnly + vbInformation, Application.UserName Set MyFolder = Nothing Set FSO = Nothing ActiveSheet.Range("J3").Value = "D:\Hukuk\UYAPDOSYALARI\Takip_Talebi_" & MaxN + 1 & ".xml"End Sub

Koduyla EXCEL sayfasındaki buton yardımıyla, D sürücüsünde, Hukuk Klasörü içindeki UYAP DOSYALARI klasörü içine XML yazılıyor.

Benim istirhamım;

D Sürücüsü/Hukuk/UYAP DOSYALARI klasörü yerine,

Hem C Sürücüsü/Hukuk/UYAP DOSYALARI klasörüne ve hemde
MASAÜSTÜNDE O AN OLUŞTURULACAK "UYAP DOSYALARI" Klasörü İÇİNE YAZILMASI.

Bunun için yukarıdaki kodda ne gibi değişiklik yapılabilir.

Şimdiden teşekkürler.

 

[İsmail Küçükşengün]

Sayın Haluk ve Veyselemre üstatlarım:

Yukarıdaki kodu, Hem C sürücüsündeki adını verdiğim klasöre ve HEM DE O AN MASAÜSTÜNDE OLUŞTURULACAK "UYAP DOSYALARIM" adlı klasöre yazdırmak için, ne gibi ilave gerekir?

Teşekkürler.

 

[veyselemre]

sayın kucuksengun, dosyanızın son halini eklerseniz onun üzerine ekleyelim, istediğiniz değişikliği.

 

[İsmail Küçükşengün]

Sayın Veyselemre;

Dosyamın son şekli ektedir.

D sürücüsünde oluşturduğum Hukuk/UYAP DOSYALARI içine XML hazırlıyor.

Benim isteğim;
D Sürücüsü/Hukuk/UYAP DOSYALARI klasörü yerine,

Hem C Sürücüsü/Hukuk/UYAP DOSYALARI klasörüne ve hemde
MASAÜSTÜNDE O AN OLUŞTURULACAK "UYAP DOSYALARI" Klasörü İÇİNE YAZILMASI.

Selam ve saygılarımla.

 

[veyselemre]

Denemeden yazdım, inşallah sorun çıkmaz.

Sub XML_Hazirla()
'......
'......
FileCopy [j3], [j4] 'ilave edin
End Sub

Sub Test()
Dim FSO As Object, MyFolder As Object, MyFile As Object
Dim MaxN As Long
Dim Temp
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFolder = FSO.GetFolder("D:\Hukuk\UYAPDOSYALARI")
    MaxN = 0
    For Each MyFile In MyFolder.Files
        If LCase(Right(MyFile.Name, 3)) = "xml" Then
            Temp = Replace(MyFile.Name, "Takip_Talebi_", Empty)
            Temp = Val(Replace(Temp, ".xml", Empty))
            If Val(Temp) > MaxN Then MaxN = Val(Temp)
       End If
    Next
    
    Set WshShell = CreateObject("WScript.Shell")
    MyDesktopPath = WshShell.SpecialFolders("Desktop")
    Set WshShell = Nothing
    
    Path = MyDesktopPath & "\UYAPDOSYALARI"
    If FSO.FolderExists(Path) = False Then FSO.CreateFolder (Path)
    
    MsgBox "D Sürücüsü/Hukuk/UYAP DOSYALARI Klasöründe Rastlanan en son uyap dosyası :" & "Takip_Talebi_" & MaxN & " .xml" _
           & vbCrLf & vbCrLf & "Yeni dosya adı : Takip_Talebi_" & MaxN + 1 & ".xml", vbOKOnly + vbInformation, Application.UserName
    
    Set MyFolder = Nothing
    Set FSO = Nothing
    ActiveSheet.Range("J3").Value = "D:\Hukuk\UYAPDOSYALARI\Takip_Talebi_" & MaxN + 1 & ".xml"
    ActiveSheet.Range("J4").Value = Path & "Takip_Talebi_" & MaxN + 1 & ".xml"
End Sub

 

[İsmail Küçükşengün]

Sayın Veyselemre;

Her zamanki gibi süpersiniz. (Gerek bilgileriniz ve gerekse paylaşımcılığınız)

Yalnız; UYAP DOSYALARI Klasörü oluşturuyor, fakat XML.yi bu klasörün içine değil de yanına yazıyor. Herhalde ben deneme yanılma ile bu hususu değiştirebilirim.(Yapamazsam yine sizleri rahatsız ederim.)

Çok teşekkürler.

 

[veyselemre]

Yalnız; UYAP DOSYALARI Klasörü oluşturuyor, fakat XML.yi bu klasörün içine değil de yanına yazıyor. Herhalde ben deneme yanılma ile bu hususu değiştirebilirim.

Şöyle deneyin.

ActiveSheet.Range("J4").Value = Path & "\Takip_Talebi_" & MaxN + 1 & ".xml"

 

[İsmail Küçükşengün]

Sayın Veyselemre;

Süpersiniz.

Çok Teşekkürler.