GetOpenFileName Yöntemi

GetOpenFileName yöntemi, kullanıcının bir veya daha fazla dosya seçmesini sağlar.

Aşağıdaki komut sadece 1 adet dosya açmamızı sağlar

Sub Dosyadan_veri_alma()

Dim DosyaSec As Variant 'burası string olamaz çünkü kullanıcı hayır'a tıkladığında false yerine "false" döndürür.
Dim DosyaAc As Workbook

Application.ScreenUpdating = False

DosyaSec = Application.GetOpenFilename(Title:="Dosya seçin", FileFilter:="Excel Files (*.xls*),*xls*")

If DosyaSec <> False Then
    Set DosyaAc = Application.Workbooks.Open(DosyaSec)
    DosyaAc.Sheets(1).Range("A1:C30").Copy
    ThisWorkbook.Worksheets("Sayfa1").Range("A1").PasteSpecial xlPasteValues
    DosyaAc.Close False
End If

Application.ScreenUpdating = True

End Sub

Aşağıdaki komutla açtığımız çalışma kitabından bir sayfa seçebiliyoruz:

Sub inputBox_ile_veri_alma()

Dim DosyaSec As Variant
Dim DosyaAc As Workbook
Dim SayfaAdi As String
Dim Sayfa As Worksheet

On Error GoTo HATA:

DosyaSec = Application.GetOpenFilename(Title:="Dosya seçin", FileFilter:="Excel Files (*.xls*),*.xls*")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If DosyaSec <> False Then
    Set DosyaAc = Application.Workbooks.Open(DosyaSec)
    SayfaAdi = Application.InputBox("Açılmasını istediğiniz sayfayı yazın", "Açılmasını istediğiniz sayfayı yazın")
    For Each Sayfa In DosyaAc.Worksheets
        If UCase(Sayfa.Name) Like "*" & UCase(SayfaAdi) & "*" Then
            SayfaAdi = Sayfa.Name
        End If
    Next Sayfa
    'seçtiğiniz sayfadan veri kopyalayın
    DosyaAc.Sheets(SayfaAdi).Range("A1:C10").Copy
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    DosyaAc.Close False
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

HATA:

If Err.Number = 9 Then
    MsgBox "Bu kelimeyi içeren bir sayfa bulunmamaktadır."
Else
    MsgBox "Bir hata oluştu. Lütfen yetkili kişiyle iletişime geçin"
End If

DosyaAc.Close False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Aşağıdaki komutla birden fazla dosya açabiliyoruz

Sub Birden_fazla_dosya_secme()

Dim DosyaSec As Variant
Dim DosyaSay As Byte
Dim SeciliDosya As Workbook

DosyaSec = Application.GetOpenFilename _
(Filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Çalışma kitaplarını seçin", _
MultiSelect:=True)

If IsArray(DosyaSec) Then
    For DosyaSay = 1 To UBound(DosyaSec)
        Set SeciliDosya = Workbooks.Open(Filename:=DosyaSec(DosyaSay))
        Range("A1").Value = "abc123"
        SeciliDosya.Close True
    Next DosyaSay
End If

End Sub

Paylaş: