xml belgesine isim vermek

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

Merhaba;

Sayın üstatların yardımıyla, verileri excel'den XML belgesine aktarıyorum.

Kodun bir bölümü;

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("J4").Value = Path & "\Takip_Talebi_" & MaxN + 1 & ".xml"
    ActiveSheet.Range("J3").Value = "D:\Hukuk\UYAPDOSYALARI\Takip_Talebi_" & MaxN + 1 & ".xml"
   
End Sub

Burada klasör içinde daha önce var olan XML belgesi adının (mesela:Takip_Talebi_2) varsa, yenisi 3 olarak isim alıyor.

BENİM İSTİRHAMIM:

Oluşturulacak XML belgesinin, excel çalışma kitabındaki ( uyap!E11 )
hücresinde bulunan ismi alması.

Yeni oluşturulacak XML belgesinin uyap!E11 hücresindeki adı alması için Yukarıdaki kodda ne gibi değişiklik gerekir.

Şimdiden teşekkürlerimle.

 

[cebir]

merhaba.
kaydeden kod u eklemediğinize göre...
(herhalde dosya kaydedilirken yolu j3 ve j4 hücrelerinden buluyor
ve bu kodlar "uyap.xls" adlı dosyada.)
öyleyse yukardaki kod un alt bölümünü aşağıdaki gibi değişiniz.
yukarıda değiştirmenize gerek bir bölüm yok
anladığım şekilde değilse kaydeden kod u inceleyelim.



sub Test()
....
...
..
..
..
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ı :" & Range("e11").Value & ".xml", vbOKOnly + vbInformation, Application.UserName

Set MyFolder = Nothing
Set FSO = Nothing
ActiveSheet.Range("J4").Value = Path & "\" & Range("e11").Value & ".xml"
ActiveSheet.Range("J3").Value = "D:\Hukuk\UYAPDOSYALARI\" & Range("e11").Value & ".xml"
End Sub

j3 hücresi yukardaki mesaj açılıncaya kadar değişmiyorsa ve boş kalmıyorsa
ilgili kod satırınıda şöyle değişelim.

MsgBox "D Sürücüsü/Hukuk/UYAP DOSYALARI Klasöründe Rastlanan en son uyap dosyası :" & Mid((Range("j3").Value), 24, Len(Range("j3").Value) - 4) & "" _
& vbCrLf & vbCrLf & "Yeni dosya adı :" & Range("e11").Value & ".xml", vbOKOnly + vbInformation, Application.UserName

 

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

Sayın Cebir;

Tam olarak istediğim buydu.

Çok teşekkür ediyorum.

Selamlarımloa.

 

[cebir]

Selamlar
kolay gelsin.