Kullanıcıların primary mail adresleri ve tüm mail adreslerinin çekilmesi
Temmuz 8, 2024
Merhaba,
Bir sistem yöneticisi olarak benden istenen;
Tüm kullanıcıların primary mail adresleri ve secondary mail adresleri çekilip, csv dosyasına kaydedilmesi istendi. primary mail adresini “mail” parametresi ile çekebiliyorum ancak diğer mail adreslerini çekebilmem için “proxyAddresses” attribute unu kullanmam gerekti. Biliyorsunuz ki proxyAddresses parametresini çektiğimde smtp:a@abc.gov.tr; sip:a@abc.gov.tr; S=a;G=b; gibi ifadeleri çekmek durumunda kaldım.
Bir makro oluşturup, sadece mail adreslerini içeren bilginin kaldığı bir vba script hazırladım.
Umarım isinize yarar :)
Kullanıcı listesini çektiğim script:
# Kullanıcıların çekileceği OU (Organizational Unit) belirleyin
$ou = "OU=xxx,DC=xxx,DC=xx,DC=xx"
# Çıkış CSV dosyasının yolu
$outputCsv = "C:scriptskullanicilar_28_05_24.csv"
# Kullanıcı bilgilerini al
$users = Get-ADUser -Filter {enabled -eq $true} -SearchBase $ou -Property SamAccountName, tckn, mail, proxyAddresses
# Kullanıcı bilgilerini uygun formatta kaydetmek için bir liste oluştur
$userList = @()
foreach ($user in $users) {
# TC Kimlik numarası extensionAttribute2 alanında saklanmış olduğunu varsayıyoruz
$tcNumber = $user.tckn
# Primary email adresi mail alanında saklanmış olduğunu varsayıyoruz
$primaryEmail = $user.mail
# Secondary email adreslerini otherMailbox alanında saklanmış olduğunu varsayıyoruz
$secondaryEmails = $user.proxyAddresses -join "; "
# Kullanıcı bilgilerini bir nesneye kaydet
$userInfo = New-Object PSObject -Property @{
"SamAccountName" = $user.SamAccountName
"TCNumber" = $tcNumber
"PrimaryEmail" = $primaryEmail
"SecondaryEmails" = $secondaryEmails
}
# Listeye ekle
$userList += $userInfo
}
# Listeyi CSV dosyasına kaydet
$userList | Export-Csv -Path $outputCsv -NoTypeInformation -Encoding UTF8
Write-Host "Kullanıcı bilgileri başarıyla $outputCsv dosyasına kaydedildi."VBA script:
Sub SadeceEmailAdresleriniBirak()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim lines As Variant
Dim newContent As String
Dim i As Integer
Dim pattern As String
Dim regex As Object
' Aktif çalışma sayfasını alın
Set ws = ActiveSheet
' İşlem yapılacak hücre aralığını seçin
' Burada B1:B3000 aralığını örnek olarak alıyorum, ihtiyacınıza göre değiştirin
Set rng = ws.Range("B1:B3000")
' E-posta adreslerini tanımak için regex deseni
pattern = "b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+.[A-Z|a-z]{2,}b"
Set regex = CreateObject("VBScript.RegExp")
regex.IgnoreCase = True
regex.Global = True
regex.Pattern = pattern
' Her hücredeki içeriği kontrol et ve sadece email adreslerini bırak
For Each cell In rng
' Hücre içeriğini satırlara böl
lines = Split(cell.Value, vbLf)
newContent = ""
' Her satırı kontrol et
For i = LBound(lines) To UBound(lines)
' Eğer satır e-posta adresi içeriyorsa
If regex.Test(lines(i)) Then
' Eğer daha önce email eklendi ise yeni satıra geç
If newContent <> "" Then
newContent = newContent & vbLf
End If
' E-posta adresini yeni içeriğe ekle
newContent = newContent & Trim(lines(i))
End If
Next i
' Temizlenmiş içeriği hücreye geri yaz
cell.Value = newContent
Next cell
End Sub