snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Public Sub ExportModules()
Dim bExport As Boolean
Dim wkbSource As Excel.Workbook
Dim szSourceWorkbook As String
Dim szExportPath As String
Dim szFileName As String
Dim cmpComponent As VBIDE.VBComponent
''' The code modules will be exported in a folder named.
''' VBAProjectFiles in the Documents folder.
''' The code below create this folder if it not exist
''' or delete all files in the folder if it exist.
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Export Folder not exist"
Exit Sub
End If
On Error Resume Next
Kill FolderWithVBAProjectFiles & "\*.*"
On Error GoTo 0
''' NOTE: This workbook must be open in Excel.
szSourceWorkbook = ActiveWorkbook.Name
Set wkbSource = Application.Workbooks(szSourceWorkbook)
If wkbSource.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to export the code"
Exit Sub
End If
szExportPath = FolderWithVBAProjectFiles & "\"
For Each cmpComponent In wkbSource.VBProject.VBComponents
bExport = True
szFileName = cmpComponent.Name
''' Concatenate the correct filename for export.
Select Case cmpComponent.Type
Case vbext_ct_ClassModule
szFileName = szFileName & ".cls"
Case vbext_ct_MSForm
szFileName = szFileName & ".frm"
Case vbext_ct_StdModule
szFileName = szFileName & ".bas"
Case vbext_ct_Document
''' This is a worksheet or workbook object.
''' Don't try to export.
bExport = False
End Select
If bExport Then
''' Export the component to a text file.
cmpComponent.Export szExportPath & szFileName
''' remove it from the project if you want
'''wkbSource.VBProject.VBComponents.Remove cmpComponent
End If
Next cmpComponent
MsgBox "Export is ready"
End Sub
Public Sub ImportModules()
Dim wkbTarget As Excel.Workbook
**Dim objFSO As Scripting.FileSystemObject**
Dim objFile As Scripting.File
Dim szTargetWorkbook As String
Dim szImportPath As String
Dim szFileName As String
Dim cmpComponents As VBIDE.VBComponents
If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Select another destination workbook" & _
"Not possible to import in this workbook "
Exit Sub
End If
'Get the path to the folder with modules
If FolderWithVBAProjectFiles = "Error" Then
MsgBox "Import Folder not exist"
Exit Sub
End If
''' NOTE: This workbook must be open in Excel.
szTargetWorkbook = ActiveWorkbook.Name
Set wkbTarget = Application.Workbooks(szTargetWorkbook)
If wkbTarget.VBProject.Protection = 1 Then
MsgBox "The VBA in this workbook is protected," & _
"not possible to Import the code"
Exit Sub
End If
''' NOTE: Path where the code modules are located.
szImportPath = FolderWithVBAProjectFiles & "\"
Set objFSO = New Scripting.FileSystemObject
If objFSO.GetFolder(szImportPath).Files.Count = 0 Then
MsgBox "There are no files to import"
Exit Sub
End If
'Delete all modules/Userforms from the ActiveWorkbook
Call DeleteVBAModulesAndUserForms
Set cmpComponents = wkbTarget.VBProject.VBComponents
''' Import all the code modules in the specified path
''' to the ActiveWorkbook.
For Each objFile In objFSO.GetFolder(szImportPath).Files
If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
(objFSO.GetExtensionName(objFile.Name) = "frm") Or _
(objFSO.GetExtensionName(objFile.Name) = "bas") Then
cmpComponents.Import objFile.Path
End If
Next objFile
MsgBox "Import is ready"
End Sub
Function FolderWithVBAProjectFiles() As String
Dim WshShell As Object
Dim FSO As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("scripting.filesystemobject")
SpecialPath = WshShell.SpecialFolders("MyDocuments")
If Right(SpecialPath, 1) <> "\" Then
SpecialPath = SpecialPath & "\"
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
On Error Resume Next
MkDir SpecialPath & "VBAProjectFiles"
On Error GoTo 0
End If
If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
Else
FolderWithVBAProjectFiles = "Error"
End If
End Function
Function DeleteVBAModulesAndUserForms()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
If VBComp.Type = vbext_ct_Document Then
'Thisworkbook or worksheet module
'We do nothing
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
End Function
Sub OpenSingleFile()
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
On Error Resume Next
Filter = "Excel Files (*.xls),*.xls,"
FilterIndex = 3
Title = "Select a File to Open"
ChDrive ("C")
ChDir ("C:")
With Application
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
ImportThisOne CStr(Filename)
End Sub
Sub ImportThisOne(sFileName As String)
On Error Resume Next
Dim oBook As Workbook
Workbooks.Open sFileName
Set oBook = ActiveWorkbook
'Now do your processing on the newly imported sheet
On Error Resume Next
'Copy new sheet into this workbook
ActiveWorkbook.import_excelfile(Sheet1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'close text file, do not save changes
oBook.Close False
Set oBook = Nothing
End Sub
Sub OpenSingleFile()
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
On Error Resume Next
Filter = "Excel Files (*.xls),*.xls,"
FilterIndex = 3
Title = "Select a File to Open"
ChDrive ("C")
ChDir ("C:\")
With Application
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
ImportThisOne CStr(Filename)
End Sub
Sub ImportThisOne(sFileName As String)
Dim oBook As Workbook
Dim myBook As Workbook
Set myBook = ThisWorkbook
Workbooks.Open sFileName
Set oBook = ActiveWorkbook
'Now do your processing on the newly imported sheet
'On Error Resume Next
'Empty sheet1 of this workbook to prepare for new data:
myBook.Sheets("Sheet1").UsedRange.Clear
'Copy new sheet into this workbook
oBook.Worksheets(1).UsedRange.Copy Destination:=myBook.Sheets("Sheet1").Range("A1")
'close text file, do not save changes
oBook.Close False
Set oBook = Nothing
End Sub
Sub OpenSingleFile()
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
On Error Resume Next
Filter = "Excel Files (*.xls),*.xls,"
FilterIndex = 3
Title = "Select a File to Open"
ChDrive ("C")
ChDir ("C:\")
With Application
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
If Filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
ImportThisOne CStr(Filename)
End Sub
Sub ImportThisOne(sFileName As String)
Dim oBook As Workbook
Dim myBook As Workbook
Set myBook = ThisWorkbook
Workbooks.Open sFileName
Set oBook = ActiveWorkbook
'Now do your processing on the newly imported sheet
'On Error Resume Next
'Empty sheet1 of this workbook to prepare for new data:
myBook.Sheets("Sheet1").UsedRange.Clear
'Copy new sheet into this workbook
oBook.Worksheets(1).UsedRange.Copy Destination:=myBook.Sheets("Sheet1").Range("A1")
'close text file, do not save changes
oBook.Close False
Set oBook = Nothing
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
ที่ต้องการคือ Import File แต่ Code ที่เขียนมานั้นเป็นการ Import Module เข้ามาใน VBA Project ซึ่งผมคิดว่าไม่ได้เป็นเรื่องเดียวกัน ช่วยอธิบายเพิ่มเติมให้ชัดเจนด้วยว่าต้องการทำอะไร ปัญหาคืออะไรและต้องการคำตอบเป็นอย่างไรครับ
