تبدیل گروهی فایل اکسل به csv با vba

با سلام خدمت کاربران عزیز آی تی سواد

در اکسل، ما می‌توانیم با Save as فایل اکسل به csv را تبدیل کنیم، اما آیا می‌دانید چگونه چندین فایل اکسل را به صورت دسته‌ای به فایل‌های CSV جداگانه تبدیل کنید؟ در این مقاله، یک کد VBA برای تبدیل دسته ای تمام فایل های اکسل در یک پوشه به فایل های CSV در اکسل معرفی می کنم.

تبدیل دسته ای فایل های اکسل یک پوشه به فایل های CSV با VBA

۱٫ بک فایل اکسل را باز کنید و کلیدهای Alt + F11 را فشار دهید تا پنجره Microsoft Visual Basic for Applications باز شود.

۲٫ برای ایجاد یک ماژول جدید، روی Insert Module کلیک کنید.

۳٫ کد زیر را کپی کرده و در پنجره جدید ماژول قرار دهید.

Sub WorkbooksSaveAsCsvToFolder()
Dim xObjWB As Workbook
Dim xObjWS As Worksheet
Dim xStrEFPath As String
Dim xStrEFFile As String
Dim xObjFD As FileDialog
Dim xObjSFD As FileDialog
Dim xStrSPath As String
Dim xStrCSVFName As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)
    xObjFD.AllowMultiSelect = False
    xObjFD.Title = "Kutools for Excel - Select a folder which contains Excel files"
    If xObjFD.Show <> -1 Then Exit Sub
    xStrEFPath = xObjFD.SelectedItems(1) & "\"

    Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjSFD.AllowMultiSelect = False
    xObjSFD.Title = "Kutools for Excel - Select a folder to locate CSV files"
    If xObjSFD.Show <> -1 Then Exit Sub
    xStrSPath = xObjSFD.SelectedItems(1) & "\"

    xStrEFFile = Dir(xStrEFPath & "*.xls*")

    Do While xStrEFFile <> ""
        Set xObjWB = Workbooks.Open(Filename:=xStrEFPath & xStrEFFile)
        xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv"
        xObjWB.SaveAs Filename:=xStrCSVFName, FileFormat:=xlCSV
        xObjWB.Close savechanges:=False
        xStrEFFile = Dir
  Loop
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub WorkbooksSaveAsCsvToFolder()

Dim xObjWB As Workbook

Dim xObjWS As Worksheet

Dim xStrEFPath As String

Dim xStrEFFile As String

Dim xObjFD As FileDialog

Dim xObjSFD As FileDialog

Dim xStrSPath As String

Dim xStrCSVFName As String

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual

On Error Resume Next

Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)

xObjFD.AllowMultiSelect = False

xObjFD.Title = "Kutools for Excel - Select a folder which contains Excel files"

If xObjFD.Show <> -1 Then Exit Sub

xStrEFPath = xObjFD.SelectedItems(1) & "\"

Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)

xObjSFD.AllowMultiSelect = False

xObjSFD.Title = "Kutools for Excel - Select a folder to locate CSV files"

If xObjSFD.Show <> -1 Then Exit Sub

xStrSPath = xObjSFD.SelectedItems(1) & "\"

xStrEFFile = Dir(xStrEFPath & "*.xls*")

Do While xStrEFFile <> ""

Set xObjWB = Workbooks.Open(Filename:=xStrEFPath & xStrEFFile)

xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv"

xObjWB.SaveAs Filename:=xStrCSVFName, FileFormat:=xlCSV

xObjWB.Close savechanges:=False

xStrEFFile = Dir

Loop

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub

۴٫ کلید F5 را فشار دهید، پوشه حاوی فایل‌های اکسل را که می‌خواهید به فایل‌های CSV تبدیل کنید، در اولین پنجره ظاهر شده انتخاب کنید.

۵٫ روی OK کلیک کنید، سپس در پنجره باز شده دوم، پوشه ای را برای ذخبره فایل های CSV انتخاب کنید.

۶٫ روی OK کلیک کنید، حالا فایل های اکسل موجود در پوشه به فایل های CSV تبدیل شده و در پوشه دیگری ذخیره شده اند.

ترجمه شده از سایت www.extendoffice.com

ممنون از همراهی شما کاربران عزیز آی تی سواد

پانوشت:در صورتی که نوشته من مورد پسندتان قرار گرفت ،در شبکه های اجتماعی به اشتراک بگذارید، این بهترین تشکر خواهد بود.

اشتراک گذاری

بیشتر

با سلام خدمت کاربران عزیز آی تی سواد

تبدیل دسته ای فایل های اکسل یک پوشه به فایل های CSV با VBA

ممنون از همراهی شما کاربران عزیز آی تی سواد

دیدگاهتان را بنویسید لغو پاسخ